Ticket #17: event.patch

File event.patch, 4.1 KB (added by Erik Huelsmann, 18 years ago)

event.lisp patch which adds support for \xHH encoded characters

  • event.lisp 

    RCS file: /project/cl-irc/cvsroot/cl-irc/event.lisp,v
retrieving revision 1.24
diff -u -r1.24 event.lisp
     
    7070    (declare (ignore target))
    7171    (let* ((connection (connection message))
    7272           (current-case-mapping (case-map-name connection)))
    73       (setf (server-capabilities connection)
    74             (reduce #'(lambda (x y)
    75                         ;; O(n^2), but we're talking small lists anyway...
    76                         ;; maybe I should have chosen a hash interface
    77                         ;; after all...
    78                         (if (assoc (first y) x :test #'string=)
    79                             x
    80                           (cons y x)))
    81                     (append
    82                      (mapcar #'(lambda (x)
    83                                  (let ((eq-pos (position #\= x)))
    84                                    (if eq-pos
    85                                        (list (subseq x 0 eq-pos)
    86                                              (subseq x (1+ eq-pos)))
    87                                      (list x)))) capabilities)
    88                      (server-capabilities connection))
    89                     :initial-value '()))
     73      (flet ((split-arg (x)
     74               (let ((eq-pos (position #\= x)))
     75                 (if eq-pos
     76                     (list (subseq x 0 eq-pos) (subseq x (1+ eq-pos)))
     77                   (list x))))
     78             (decode-arg (text)
     79                ;; decode \xHH to (code-char HH)
     80                (format nil "~{~A~}"
     81                        (do* ((start 0 (+ 4 pos))
     82                              (pos (search "\\x" text)
     83                                   (search "\\x" text :start2 (1+ pos)))
     84                              (points))
     85                            ((null pos)
     86                             (reverse (push (subseq text start) points)))
     87                          (push (subseq text start pos) points)
     88                          (push (code-char (parse-integer text
     89                                                          :start (+ 2 pos)
     90                                                          :end (+ 4 pos)
     91                                                          :junk-allowed nil
     92                                                          :radix 16))
     93                                points))))
     94             (negate-param (param)
     95               (if (eq #\- (char (first param) 0))
     96                   (assoc (subseq (first param) 1) *default-isupport-values*
     97                          :test #'string=)
     98                 param)))
     99        (setf (server-capabilities connection)
     100              (reduce #'(lambda (x y)
     101                          ;; O(n^2), but we're talking small lists anyway...
     102                          ;; maybe I should have chosen a hash interface
     103                          ;; after all...
     104                          (if (assoc (first y) x :test #'string=)
     105                              x
     106                            (cons y x)))
     107                      (append
     108                       (mapcar #'(lambda (x)
     109                                   (if (second x)
     110                                       (list (first x) (decode-arg (second x)))
     111                                     x))
     112                               (remove nil (mapcar #'negate-param
     113                                                   (mapcar #'split-arg
     114                                                           capabilities))))
     115                       (server-capabilities connection))
     116                      :initial-value '())))
    90117      (setf (channel-mode-descriptions connection)
    91118            (chanmode-descs-from-isupport (server-capabilities connection))
    92119            (nick-prefixes connection)
    … …  
    121148
    122149(defmethod default-hook ((message irc-rpl_topic-message))
    123150  (destructuring-bind
    124       (target channel topic)
     151      (target channel &optional topic)
    125152      (arguments message)
    126153    (declare (ignore target))
    127154    (setf (topic (find-channel (connection message) channel)) topic)))