Rewrite ctlseq parsing logic.

[riece] / lisp / riece-ctlseq.el

diff --git a/lisp/riece-ctlseq.el b/lisp/riece-ctlseq.el
index 87729d5..b1bb87d 100644 (file)
--- a/lisp/riece-ctlseq.el
+++ b/lisp/riece-ctlseq.el
@@ -1,4 +1,4 @@
-;;; riece-ctlseq.el --- highlight control sequences in channel buffers
+;;; riece-ctlseq.el --- mark up control sequences in IRC buffers

 ;; Copyright (C) 1998-2004 Daiki Ueno
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
 ;; Copyright (C) 1998-2004 Daiki Ueno
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>


@@ -19,27 +19,50 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the

-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

-;; To use, add the following line to your ~/.riece/init.el:
-;; (add-to-list 'riece-addons 'riece-ctlseq)
+;; NOTE: This is an add-on module for Riece.

 
 ;;; Code:
 
 
 ;;; Code:
 

-(require 'riece-highlight)
+(require 'riece-message)
+(require 'riece-misc)

 
 

-(defvar riece-ctlseq-colors
+(defgroup riece-ctlseq nil
+  "Mark up control sequences in IRC buffer."
+  :prefix "riece-"
+  :group 'riece)
+
+(defcustom riece-ctlseq-colors

   '("white" "black" "red" "orange" "yellow" "LightGreen" "DarkOliveGreen"
     "cyan4" "turquoise" "blue" "black" "black" "black" "black" "black"
   '("white" "black" "red" "orange" "yellow" "LightGreen" "DarkOliveGreen"
     "cyan4" "turquoise" "blue" "black" "black" "black" "black" "black"

-    "DarkBlue" "purple1" "purple2" "purple3" "magenta"))
+    "DarkBlue" "purple1" "purple2" "purple3" "magenta")
+  "List of colors can be used with ^C<fg>,<bg>."
+  :group 'riece-ctlseq
+  :type '(repeat (string :tag "Color")))
+
+(defcustom riece-ctlseq-hide-controls t
+  "If non-nil, control characters are hidden."
+  :group 'riece-ctlseq
+  :type 'boolean)
+
+(defcustom riece-ctlseq-face-cache-size 128
+  "Maximum length of the internal face cache."
+  :group 'riece-ctlseq
+  :type 'integer)

 
 (defvar riece-ctlseq-face-cache nil)
 
 (defvar riece-ctlseq-face-cache nil)

-(defvar riece-ctlseq-face-cache-size 128)

 (defvar riece-ctlseq-face-counter 0)
 
 (defvar riece-ctlseq-face-counter 0)
 

+(defconst riece-ctlseq-description
+  "Mark up control sequences in IRC buffers.")
+
+(defconst riece-ctlseq-regexp
+  "[\x2\xF\x16\x1F]\\|\x3\\([0-9]+\\)?\\(,[0-9]+\\)?")
+

 (defun riece-ctlseq-compatible-attributes-p (this other)
   (let ((pointer this))
     (catch 'mismatched
 (defun riece-ctlseq-compatible-attributes-p (this other)
   (let ((pointer this))
     (catch 'mismatched


@@ -112,66 +135,82 @@
                    riece-ctlseq-face-cache))
        (car riece-ctlseq-face-cache)))))
 
                    riece-ctlseq-face-cache))
        (car riece-ctlseq-face-cache)))))
 

-(defun riece-ctlseq-update-attributes (tag attrs)
-  (cond
-   ((eq (aref tag 0) ?\x2)             ;^B
-    (plist-put attrs 'bold (not (plist-get attrs 'bold))))
-   ((eq (aref tag 0) ?\xF))            ;^O
-   ((eq (aref tag 0) ?\x16)            ;^V
-    (plist-put attrs 'inverse-video (not (plist-get attrs 'inverse-video))))
-   ((eq (aref tag 0) ?\x1F)            ;^_
-    (plist-put attrs 'underline (not (plist-get attrs 'underline))))
-   ((string-match "\x3\\([0-9]+\\)?\\(,[0-9]+\\)?" tag)        ;^C<fg>,<bg>
-    (if (match-beginning 1)
-       (setq attrs (plist-put attrs 'foreground
-                              (nth (string-to-number (match-string 1 tag))
-                                   riece-ctlseq-colors))))
-    (if (match-beginning 2)
-       (setq attrs (plist-put attrs 'background
-                              (nth (string-to-number
-                                    (substring (match-string 2 tag) 1))
-                                   riece-ctlseq-colors))))
-    attrs)))
+(defun riece-ctlseq-update-attribute (tag attrs)
+  (let ((attrs (copy-sequence attrs)))
+    (cond
+     ((eq (aref tag 0) ?\x2)           ;^B
+      (setq attrs (plist-put attrs 'bold (not (plist-get attrs 'bold)))))
+     ((eq (aref tag 0) ?\xF)           ;^O
+      (setq attrs nil))
+     ((eq (aref tag 0) ?\x16)          ;^V
+      (setq attrs (plist-put attrs 'inverse-video
+                            (not (plist-get attrs 'inverse-video)))))
+     ((eq (aref tag 0) ?\x1F)          ;^_
+      (setq attrs (plist-put attrs 'underline
+                            (not (plist-get attrs 'underline)))))
+     ((string-match "\x3\\([0-9]+\\)?\\(,[0-9]+\\)?" tag) ;^C<fg>,<bg>
+      (if (match-beginning 1)
+         (setq attrs (plist-put attrs 'foreground
+                                (nth (string-to-number (match-string 1 tag))
+                                     riece-ctlseq-colors))))
+      (if (match-beginning 2)
+         (setq attrs (plist-put attrs 'background
+                                (nth (string-to-number
+                                      (substring (match-string 2 tag) 1))
+                                     riece-ctlseq-colors))))))
+    attrs))
+
+(defun riece-ctlseq-update-attributes (tags attrs)
+  (let ((start 0))
+    (while (string-match riece-ctlseq-regexp tags start)
+      (setq start (match-end 0)
+           attrs (riece-ctlseq-update-attribute (match-string 0 tags) attrs)))
+    attrs))
+
+(defun riece-ctlseq-put-attributes (string start end attrs)
+  (when (and (> end start) attrs)
+    (put-text-property start end
+                      'riece-ctlseq-attributes (copy-sequence attrs)
+                      (riece-message-text message))
+    (put-text-property start end
+                      'riece-overlay-face
+                      (riece-ctlseq-face-from-cache attrs)
+                      (riece-message-text message))))

 
 (defun riece-ctlseq-message-filter (message)
 
 (defun riece-ctlseq-message-filter (message)

-  (let ((start 0)
-       (end (length (riece-message-text message)))
-       attrs)
-    (while (string-match
-           "[\x2\xF\x16\x1F]\\|\x3\\([0-9]+\\)?\\(,[0-9]+\\)?"
-           (riece-message-text message) start)
-      (put-text-property (match-beginning 0) (match-end 0)
-                        'invisible 'riece-ctlseq (riece-message-text message))
-      (if attrs
-         (put-text-property start (match-beginning 0)
-                            'riece-ctlseq-attributes (copy-sequence attrs)
-                            (riece-message-text message)))
-      (setq start (match-end 0)
-           attrs (riece-ctlseq-update-attributes
-                  (match-string 0 (riece-message-text message)) attrs)))
-    (if (and (< start end) attrs)
-       (put-text-property start end
-                          'riece-ctlseq-attributes (copy-sequence attrs)
-                          (riece-message-text message))))
+  (if (get 'riece-ctlseq 'riece-addon-enabled)
+      (let ((start 0)
+           (end (length (riece-message-text message)))
+           tags-start tags-end attrs)
+       (while (string-match (concat "\\(" riece-ctlseq-regexp "\\)+")
+                            (riece-message-text message) start)
+         (if riece-ctlseq-hide-controls
+             (put-text-property (match-beginning 0) (match-end 0)
+                                'invisible 'riece-ctlseq
+                                (riece-message-text message)))
+         (setq tags-start (match-beginning 0)
+               tags-end (match-end 0))
+         (riece-ctlseq-put-attributes (riece-message-text message)
+                                      start tags-start
+                                      attrs)
+         (setq attrs (riece-ctlseq-update-attributes
+                      (substring (riece-message-text message)
+                                 tags-start tags-end)
+                      attrs)
+               start tags-end))
+       (riece-ctlseq-put-attributes (riece-message-text message)
+                                    start end
+                                    attrs)))

   message)
 
   message)
 

-(defun riece-ctlseq-scan-region (start end)
-  (riece-scan-property-region
-   'riece-ctlseq-attributes
-   start end
-   (lambda (start end)
-     (riece-overlay-put (riece-make-overlay start end)
-                       'face
-                       (riece-ctlseq-face-from-cache
-                        (get-text-property start
-                                           'riece-ctlseq-attributes))))))
-

 (defun riece-ctlseq-requires ()
   '(riece-highlight))
 (defun riece-ctlseq-requires ()
   '(riece-highlight))

-                           
+

 (defun riece-ctlseq-insinuate ()
 (defun riece-ctlseq-insinuate ()

-  (add-hook 'riece-message-filter-functions 'riece-ctlseq-message-filter)
-  (add-hook 'riece-after-insert-functions 'riece-ctlseq-scan-region))
+  (add-hook 'riece-message-filter-functions 'riece-ctlseq-message-filter))
+
+(defun riece-ctlseq-uninstall ()
+  (remove-hook 'riece-message-filter-functions 'riece-ctlseq-message-filter))

 
 (provide 'riece-ctlseq)
 
 
 (provide 'riece-ctlseq)