Fixed issue with being able to insert chars into the prompt.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index 2a95e48..675ec0e 100644 (file)
--- a/lurk.el
+++ b/lurk.el
@@ -351,8 +351,10 @@ portion of the source component of the message, as LURK doesn't use this.")
                          "")
                        'face 'lurk-context
                        'read-only t)
-           (propertize (concat lurk-prompt-string " ")
+           (propertize lurk-prompt-string
                        'face 'lurk-prompt
+                       'read-only t)
+           (propertize " " ; Need this to be separate to mark it as rear-nonsticky
                        'read-only t
                        'rear-nonsticky t)))
         (set-marker-insertion-type lurk-input-marker nil))
@@ -580,7 +582,8 @@ portion of the source component of the message, as LURK doesn't use this.")
           (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)))
@@ -594,7 +597,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)))
-            ("\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)))
@@ -810,23 +819,55 @@ in which case they match anything.")
    lurk-autoreply-table))
 
 
-;;; Command entering
+;;; Commands
 ;;
 
 (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)
-    ("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)
-    ("MSG" "Send private message to user." lurk-command-msg))
+    ("MSG" "Send private message to user." lurk-command-msg lurk-nick-completions)
+    ("HELP" "Display help on client commands." lurk-command-help lurk-help-completions))
   "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))
+
+(defun lurk-help-completions ()
+  (mapcar (lambda (row) (car row)) lurk-command-table))
+
+(defun lurk-command-help (params)
+  (if params
+      (let* ((cmd-str (upcase (car params)))
+             (row (assoc cmd-str lurk-command-table #'equal)))
+        (if row
+            (progn
+              (lurk-display-notice nil "Help for \x02" cmd-str "\x02:")
+              (lurk-display-notice nil "  " (elt row 1)))
+          (lurk-display-notice nil "No such (client-interpreted) command.")))
+    (lurk-display-notice nil "Client-interpreted commands:")
+    (dolist (row lurk-command-table)
+      (lurk-display-notice nil "  \x02" (elt row 0) "\x02: " (elt row 1)))
+    (lurk-display-notice nil "Use /HELP COMMAND to display information about a specific command.")))
+
+;;; Command entering
+;;
 
 (defun lurk-enter-string (string)
   (if (string-prefix-p "/" string)
@@ -937,13 +978,17 @@ in which case they match anything.")
     (lurk-display-notice nil "No current channel.")))
 
 (defun lurk-command-msg (params)
-  (if (and params (>= 2 (length params)))
+  (if (and params (>= (length params) 2))
       (let ((to (car params))
             (text (string-join (cdr params) " ")))
         (lurk-send-msg (lurk-msg nil nil "PRIVMSG" to text))
         (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.")
 
@@ -981,6 +1026,7 @@ in which case they match anything.")
   (interactive)
   (lurk-history-cycle +1))
 
+
 ;;; Interactive functions
 ;;
 
@@ -1007,23 +1053,24 @@ in which case they match anything.")
   (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
-                            (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-nospace (funcall (elt table-row 3)))
+                      (completions (mapcar (lambda (el) (concat el " ")) completions-nospace)))
+                 (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)
-                               (mapcar (lambda (row) (string-join (list "/" (car row))))
+                               (mapcar (lambda (row) (concat "/" (car row) " "))
                                        lurk-command-table)))
         (_
          (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)))))))))