Fixed error in quit command definition.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index 45d9424..fb0178c 100644 (file)
--- a/lurk.el
+++ b/lurk.el
@@ -65,27 +65,27 @@
   "Face used for Lurk text.")
 
 (defface lurk-prompt
   "Face used for Lurk text.")
 
 (defface lurk-prompt

-  '((t :inherit org-priority))
+  '((t :inherit font-lock-keyword-face))

   "Face used for the prompt.")
 
 (defface lurk-context
   "Face used for the prompt.")
 
 (defface lurk-context

-  '((t :inherit org-tag))
+  '((t :inherit lurk-context))

   "Face used for the context name in the prompt.")
 
 (defface lurk-faded
   "Face used for the context name in the prompt.")
 
 (defface lurk-faded

-  '((t :inherit org-agenda-dimmed-todo-face))
+  '((t :inherit shadow))

   "Face used for faded Lurk text.")
 
 (defface lurk-timestamp
   "Face used for faded Lurk text.")
 
 (defface lurk-timestamp

-  '((t :inherit org-agenda-dimmed-todo-face))
+  '((t :inherit shadow))

   "Face used for timestamps.")
 
 (defface lurk-error
   "Face used for timestamps.")
 
 (defface lurk-error

-  '((t :inherit font-lock-regexp-grouping-construct))
+  '((t :inherit error))

   "Face used for Lurk error text.")
 
 (defface lurk-notice
   "Face used for Lurk error text.")
 
 (defface lurk-notice

-  '((t :inherit org-upcoming-deadline))
+  '((t :inherit warning))

   "Face used for Lurk notice text.")
 
 ;;; Global variables
   "Face used for Lurk notice text.")
 
 ;;; Global variables


@@ -351,8 +351,10 @@ portion of the source component of the message, as LURK doesn't use this.")
                          "")
                        'face 'lurk-context
                        'read-only t)
                          "")
                        'face 'lurk-context
                        'read-only t)

-           (propertize (concat lurk-prompt-string " ")
+           (propertize lurk-prompt-string

                        'face 'lurk-prompt
                        '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))
                        '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)))
           (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 +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)))
             ("\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)))


@@ -817,6 +826,7 @@ in which case they match anything.")
   '(("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)
   '(("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)

+    ("NETWORKS" "List known IRC networks." lurk-command-networks)

     ("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)


@@ -824,7 +834,8 @@ in which case they match anything.")
     ("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 lurk-nick-completions))
+    ("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 ()
   "Table of commands explicitly supported by Lurk.")
 
 (defun lurk-boolean-completions ()


@@ -839,34 +850,22 @@ in which case they match anything.")
 (defun lurk-context-completions ()
   (lurk-get-context-list))
 
 (defun lurk-context-completions ()
   (lurk-get-context-list))
 

+(defun lurk-help-completions ()
+  (mapcar (lambda (row) (car row)) lurk-command-table))

 
 

-;;; Command entering
-;;
-
-(defun lurk-enter-string (string)
-  (if (string-prefix-p "/" string)
-      (pcase string
-        ((rx (: "/" (let cmd-str (+ (not whitespace)))
-                (opt (+ whitespace)
-                     (let params-str (+ anychar))
-                     string-end)))
-         (let ((command-row (assoc (upcase  cmd-str) lurk-command-table #'equal))
-               (params (if params-str
-                           (split-string params-str nil t)
-                         nil)))
-           (if command-row
-               (funcall (elt command-row 2) params)
-             (lurk-send-msg (lurk-msg nil nil (upcase cmd-str) params)))))
-        (_
-         (lurk-display-error "Badly formed command.")))
-    (unless (string-empty-p string)
-      (if lurk-current-context
-          (progn
-            (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
-                                     lurk-current-context
-                                     string))
-            (lurk-display-message lurk-nick lurk-current-context string))
-        (lurk-display-error "No current context.")))))
+(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.")))

 
 (defun lurk-command-debug (params)
   (setq lurk-debug 
 
 (defun lurk-command-debug (params)
   (setq lurk-debug 


@@ -895,9 +894,14 @@ in which case they match anything.")
         (lurk-connect network))
     (lurk-display-notice nil "Usage: /connect <network>")))
 
         (lurk-connect network))
     (lurk-display-notice nil "Usage: /connect <network>")))
 

-(defun lurk-command-quit (params)
-  (let ((quit-msg (if params (string-join params " ") nil)))
-    (lurk-send-msg (lurk-msg nil nil "QUIT" quit-msg))))
+(defun lurk-command-networks (params)
+  (lurk-display-notice nil "Currently-known networks:")
+  (dolist (row lurk-networks)
+    (seq-let (network server port &rest others) row
+      (lurk-display-notice nil "\t" network
+                           " [" server
+                           " " (number-to-string port) "]")))
+  (lurk-display-notice nil "(Modify the `lurk-networks' variable to add more.)"))

 
 (defun lurk-command-part (params)
   (let ((channel (if params (car params) lurk-current-context)))
 
 (defun lurk-command-part (params)
   (let ((channel (if params (car params) lurk-current-context)))


@@ -914,7 +918,7 @@ in which case they match anything.")
     (lurk-display-notice nil "Usage: /version <nick>")))
 
 (defun lurk-command-quit (params)
     (lurk-display-notice nil "Usage: /version <nick>")))
 
 (defun lurk-command-quit (params)

-  (let ((quit-msg (if params (string-join parms " ") lurk-default-quit-msg)))
+  (let ((quit-msg (if params (string-join params " ") lurk-default-quit-msg)))

     (lurk-send-msg (lurk-msg nil nil "QUIT" quit-msg))))
 
 (defun lurk-command-nick (params)
     (lurk-send-msg (lurk-msg nil nil "QUIT" quit-msg))))
 
 (defun lurk-command-nick (params)


@@ -952,7 +956,7 @@ in which case they match anything.")
     (lurk-display-notice nil "No current channel.")))
 
 (defun lurk-command-msg (params)
     (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))
       (let ((to (car params))
             (text (string-join (cdr params) " ")))
         (lurk-send-msg (lurk-msg nil nil "PRIVMSG" to text))


@@ -960,24 +964,41 @@ in which case they match anything.")
     (lurk-display-notice nil "Usage: /msg <nick> <message>")))
 
 
     (lurk-display-notice nil "Usage: /msg <nick> <message>")))
 
 

+;;; Command entering
+;;
+
+(defun lurk-enter-string (string)
+  (if (string-prefix-p "/" string)
+      (pcase string
+        ((rx (: "/" (let cmd-str (+ (not whitespace)))
+                (opt (+ whitespace)
+                     (let params-str (+ anychar))
+                     string-end)))
+         (let ((command-row (assoc (upcase  cmd-str) lurk-command-table #'equal))
+               (params (if params-str
+                           (split-string params-str nil t)
+                         nil)))
+           (if command-row
+               (funcall (elt command-row 2) params)
+             (lurk-send-msg (lurk-msg nil nil (upcase cmd-str) params)))))
+        (_
+         (lurk-display-error "Badly formed command.")))
+    (unless (string-empty-p string)
+      (if lurk-current-context
+          (progn
+            (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
+                                     lurk-current-context
+                                     string))
+            (lurk-display-message lurk-nick lurk-current-context string))
+        (lurk-display-error "No current context.")))))
+
+

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

-
-(defun lurk-enter ()
-  "Enter current contents of line after prompt."
-  (interactive)
-  (with-current-buffer "*lurk*"
-    (let ((line (buffer-substring lurk-input-marker (point-max))))
-      (push line lurk-history)
-      (setq lurk-history-index nil)
-      (let ((inhibit-read-only t))
-        (delete-region lurk-input-marker (point-max)))
-      (lurk-enter-string line))))
-

 (defvar lurk-history-index nil)
 
 (defun lurk-history-cycle (delta)
 (defvar lurk-history-index nil)
 
 (defun lurk-history-cycle (delta)


@@ -992,14 +1013,6 @@ in which case they match anything.")
       (delete-region lurk-input-marker (point-max))
       (insert (elt lurk-history lurk-history-index)))))
 
       (delete-region lurk-input-marker (point-max))
       (insert (elt lurk-history lurk-history-index)))))
 

-(defun lurk-history-next ()
-  (interactive)
-  (lurk-history-cycle -1))
-
-(defun lurk-history-prev ()
-  (interactive)
-  (lurk-history-cycle +1))
-

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


@@ -1022,6 +1035,14 @@ in which case they match anything.")
     (lurk-zoom-in lurk-current-context))
   (setq lurk-zoomed (not lurk-zoomed)))
 
     (lurk-zoom-in lurk-current-context))
   (setq lurk-zoomed (not lurk-zoomed)))
 

+(defun lurk-history-next ()
+  (interactive)
+  (lurk-history-cycle -1))
+
+(defun lurk-history-prev ()
+  (interactive)
+  (lurk-history-cycle +1))
+

 (defun lurk-complete-input ()
   (interactive)
   (let ((completion-ignore-case t))
 (defun lurk-complete-input ()
   (interactive)
   (let ((completion-ignore-case t))


@@ -1032,12 +1053,13 @@ in which case they match anything.")
                             (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))
                             (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))))
+               (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)
                  (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)))
                                        lurk-command-table)))
         (_
          (let* ((end (max lurk-input-marker (point)))


@@ -1047,6 +1069,17 @@ in which case they match anything.")
            (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)))))))))
 

+(defun lurk-enter ()
+  "Enter current contents of line after prompt."
+  (interactive)
+  (with-current-buffer "*lurk*"
+    (let ((line (buffer-substring lurk-input-marker (point-max))))
+      (push line lurk-history)
+      (setq lurk-history-index nil)
+      (let ((inhibit-read-only t))
+        (delete-region lurk-input-marker (point-max)))
+      (lurk-enter-string line))))
+

 
 ;;; Mode
 ;;
 
 ;;; Mode
 ;;


@@ -1054,12 +1087,15 @@ in which case they match anything.")
 (defvar lurk-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "RET") 'lurk-enter)
 (defvar lurk-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "RET") 'lurk-enter)

-    (define-key map (kbd "<tab>") 'lurk-complete-input)
+    (define-key map (kbd "TAB") 'lurk-complete-input)

     (define-key map (kbd "C-c C-z") 'lurk-toggle-zoom)
     (define-key map (kbd "<C-tab>") 'lurk-cycle-contexts-forward)
     (define-key map (kbd "<C-S-tab>") 'lurk-cycle-contexts-reverse)
     (define-key map (kbd "<C-up>") 'lurk-history-prev)
     (define-key map (kbd "<C-down>") 'lurk-history-next)
     (define-key map (kbd "C-c C-z") 'lurk-toggle-zoom)
     (define-key map (kbd "<C-tab>") 'lurk-cycle-contexts-forward)
     (define-key map (kbd "<C-S-tab>") 'lurk-cycle-contexts-reverse)
     (define-key map (kbd "<C-up>") 'lurk-history-prev)
     (define-key map (kbd "<C-down>") 'lurk-history-next)

+    (when (fboundp 'evil-define-key*)
+      (evil-define-key* 'motion map
+        (kbd "TAB") 'lurk-complete-input))

     map))
 
 (defvar lurk-mode-map)
     map))
 
 (defvar lurk-mode-map)


@@ -1070,17 +1106,21 @@ in which case they match anything.")
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'lurk-mode 'insert))
 
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'lurk-mode 'insert))
 

+

 ;;; Main start procedure
 ;;
 
 ;;; Main start procedure
 ;;
 

-(defun lurk ()
-  "Switch to *lurk* buffer."
+(defun lurk (&optional network)
+  "Start lurk or just switch to the lurk buffer if one already exists.
+Also connect to NETWORK if non-nil."

   (interactive)
   (if (get-buffer "*lurk*")
       (switch-to-buffer "*lurk*")
     (switch-to-buffer "*lurk*")
     (lurk-mode)
   (interactive)
   (if (get-buffer "*lurk*")
       (switch-to-buffer "*lurk*")
     (switch-to-buffer "*lurk*")
     (lurk-mode)

-    (lurk-setup-buffer))
+    (lurk-setup-buffer)
+    (if network
+        (lurk-command-connect (list network))))

   "Started LURK.")
 
 
   "Started LURK.")