Strip out colour formatting codes.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index 2a95e48..68fff0d 100644 (file)
--- a/lurk.el
+++ b/lurk.el
@@ -580,7 +580,8 @@ portion of the source component of the message, as LURK doesn't use this.")
           (underline nil)
           (strikethrough nil)
           (prev-point (point)))
           (underline nil)
           (strikethrough nil)
           (prev-point (point)))

-      (while (re-search-forward (rx (any "\x02\x1D\x1F\x1E")) nil t)
+      (while (re-search-forward (rx (or (any "\x02\x1D\x1F\x1E\x0F")
+                                        (: "\x03" (+ digit) (opt "," (* digit))))) nil t)

         (let ((beg (+ (match-beginning 0) 1)))
           (if bold
               (add-face-text-property prev-point beg '(:weight bold)))
         (let ((beg (+ (match-beginning 0) 1)))
           (if bold
               (add-face-text-property prev-point beg '(:weight bold)))


@@ -594,7 +595,13 @@ portion of the source component of the message, as LURK doesn't use this.")
             ("\x02" (setq bold (not bold)))
             ("\x1D" (setq italics (not italics)))
             ("\x1F" (setq underline (not underline)))
             ("\x02" (setq bold (not bold)))
             ("\x1D" (setq italics (not italics)))
             ("\x1F" (setq underline (not underline)))

-            ("\x1E" (setq strikethrough (not strikethrough))))
+            ("\x1E" (setq strikethrough (not strikethrough)))
+            ("\x0F" ; Reset
+             (setq bold nil)
+             (setq italics nil)
+             (setq underline nil)
+             (setq strikethrough nil))
+            (_))

           (delete-region (match-beginning 0) (match-end 0))
           (setq prev-point (point)))))
     (buffer-string)))
           (delete-region (match-beginning 0) (match-end 0))
           (setq prev-point (point)))))
     (buffer-string)))


@@ -810,23 +817,38 @@ in which case they match anything.")
    lurk-autoreply-table))
 
 
    lurk-autoreply-table))
 
 

-;;; Command entering
+;;; Commands

 ;;
 
 (defvar lurk-command-table
 ;;
 
 (defvar lurk-command-table

-  '(("DEBUG" "Toggle debug mode on/off." lurk-command-debug)
-    ("HEADER" "Toggle display of header." lurk-command-header)
-    ("CONNECT" "Connect to an IRC network." lurk-command-connect)
+  '(("DEBUG" "Toggle debug mode on/off." lurk-command-debug lurk-boolean-completions)
+    ("HEADER" "Toggle display of header." lurk-command-header lurk-boolean-completions)
+    ("CONNECT" "Connect to an IRC network." lurk-command-connect lurk-network-completions)

     ("TOPIC" "Set topic for current channel." lurk-command-topic)
     ("ME" "Display action." lurk-command-me)
     ("VERSION" "Request version of another user's client via CTCP." lurk-command-version)
     ("TOPIC" "Set topic for current channel." lurk-command-topic)
     ("ME" "Display action." lurk-command-me)
     ("VERSION" "Request version of another user's client via CTCP." lurk-command-version)

-    ("PART" "Leave channel." lurk-command-part)
+    ("PART" "Leave channel." lurk-command-part lurk-context-completions)

     ("QUIT" "Disconnect from current network." lurk-command-quit)
     ("NICK" "Change nick." lurk-command-nick)
     ("LIST" "Display details of one or more channels." lurk-command-list)
     ("QUIT" "Disconnect from current network." lurk-command-quit)
     ("NICK" "Change nick." lurk-command-nick)
     ("LIST" "Display details of one or more channels." lurk-command-list)

-    ("MSG" "Send private message to user." lurk-command-msg))
+    ("MSG" "Send private message to user." lurk-command-msg lurk-nick-completions))

   "Table of commands explicitly supported by Lurk.")
 
   "Table of commands explicitly supported by Lurk.")
 

+(defun lurk-boolean-completions ()
+  '("on" "off"))
+
+(defun lurk-network-completions ()
+  (mapcar (lambda (row) (car row)) lurk-networks))
+
+(defun lurk-nick-completions ()
+  (lurk-get-context-users lurk-current-context))
+
+(defun lurk-context-completions ()
+  (lurk-get-context-list))
+
+
+;;; Command entering
+;;

 
 (defun lurk-enter-string (string)
   (if (string-prefix-p "/" string)
 
 (defun lurk-enter-string (string)
   (if (string-prefix-p "/" string)


@@ -944,6 +966,10 @@ in which case they match anything.")
         (lurk-display-message lurk-nick to text))
     (lurk-display-notice nil "Usage: /msg <nick> <message>")))
 
         (lurk-display-message lurk-nick to text))
     (lurk-display-notice nil "Usage: /msg <nick> <message>")))
 

+
+;;; Command history
+;;
+

 (defvar lurk-history nil
   "Commands and messages sent in current session.")
 
 (defvar lurk-history nil
   "Commands and messages sent in current session.")
 


@@ -981,6 +1007,7 @@ in which case they match anything.")
   (interactive)
   (lurk-history-cycle +1))
 
   (interactive)
   (lurk-history-cycle +1))
 

+

 ;;; Interactive functions
 ;;
 
 ;;; Interactive functions
 ;;
 


@@ -1007,12 +1034,13 @@ in which case they match anything.")
   (let ((completion-ignore-case t))
     (when (and (>= (point) lurk-input-marker))
       (pcase (buffer-substring lurk-input-marker (point))
   (let ((completion-ignore-case t))
     (when (and (>= (point) lurk-input-marker))
       (pcase (buffer-substring lurk-input-marker (point))

-        ((rx (: "/connect" (+ " ") (* (not whitespace)) string-end))
+        ((rx (: "/" (let cmd-str (+ (not whitespace))) (+ " ") (* (not whitespace)) string-end))

          (let ((space-idx (save-excursion
          (let ((space-idx (save-excursion

-                            (re-search-backward " " lurk-input-marker t))))
-           (completion-in-region (+ 1 space-idx)
-                                 (point)
-                                 (mapcar (lambda (row) (car row)) lurk-networks))))
+                            (re-search-backward " " lurk-input-marker t)))
+               (table-row (assoc (upcase cmd-str) lurk-command-table #'equal)))
+           (if (and table-row (elt table-row 3))
+               (let ((completions (funcall (elt table-row 3))))
+                 (completion-in-region (+ 1 space-idx) (point) completions)))))

         ((rx (: "/" (* (not whitespace)) string-end))
          (message (buffer-substring lurk-input-marker (point)))
          (completion-in-region lurk-input-marker (point)
         ((rx (: "/" (* (not whitespace)) string-end))
          (message (buffer-substring lurk-input-marker (point)))
          (completion-in-region lurk-input-marker (point)


@@ -1022,8 +1050,7 @@ in which case they match anything.")
          (let* ((end (max lurk-input-marker (point)))
                 (space-idx (save-excursion
                              (re-search-backward " " lurk-input-marker t)))
          (let* ((end (max lurk-input-marker (point)))
                 (space-idx (save-excursion
                              (re-search-backward " " lurk-input-marker t)))

-                (start (if space-idx (+ 1 space-idx) lurk-input-marker))
-                (completion-ignore-case t))
+                (start (if space-idx (+ 1 space-idx) lurk-input-marker)))

            (unless (string-prefix-p "/" (buffer-substring start end))
              (completion-in-region start end (lurk-get-context-users lurk-current-context)))))))))
 
            (unless (string-prefix-p "/" (buffer-substring start end))
              (completion-in-region start end (lurk-get-context-users lurk-current-context)))))))))