X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=lurk.git;a=blobdiff_plain;f=lurk.el;h=edfb66fe7d6b79b90021d2d35b7a8c79ea85c7df;hp=42f4cdb397af85ea559073caf6dfad5e148ff533;hb=HEAD;hpb=0d70a53705ca8bd1f01d49361754409ccef4d428

diff --git a/lurk.el b/lurk.el
index 42f4cdb..52ee3b6 100644
--- a/lurk.el
+++ b/lurk.el
@@ -65,27 +65,27 @@
   "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
-  '((t :inherit org-tag))
+  '((t :inherit lurk-context))
   "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
-  '((t :inherit org-agenda-dimmed-todo-face))
+  '((t :inherit shadow))
   "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
-  '((t :inherit org-upcoming-deadline))
+  '((t :inherit warning))
   "Face used for Lurk notice text.")
 
 ;;; Global variables
@@ -271,10 +271,13 @@ portion of the source component of the message, as LURK doesn't use this.")
 (defun lurk-get-context-users (name)
   (gethash name lurk-contexts))
 
+(defun lurk-context-known-p (name)
+  (not (eq (gethash name lurk-contexts 0) 0)))
+
 (defun lurk-add-context-users (context users)
   (puthash context
-           (append users
-                   (gethash context lurk-contexts))
+           (cl-union users
+                     (gethash context lurk-contexts))
            lurk-contexts))
 
 (defun lurk-del-context-user (context user)
@@ -318,14 +321,13 @@ portion of the source component of the message, as LURK doesn't use this.")
 (defun lurk-set-current-context (context)
   (setq lurk-current-context context)
   (lurk-highlight-context context)
+  (lurk-render-prompt)
   (if lurk-zoomed
       (lurk-zoom-in lurk-current-context)))
 
 (defun lurk-cycle-contexts (&optional rev)
   (if lurk-current-context
-      (progn
-        (lurk-set-current-context (lurk-get-next-context rev))
-        (lurk-render-prompt))
+      (lurk-set-current-context (lurk-get-next-context rev))
     (lurk-display-error "No channels joined.")))
 
 
@@ -351,8 +353,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))
@@ -404,6 +408,11 @@ portion of the source component of the message, as LURK doesn't use this.")
     (if lurk-display-header
         (lurk-setup-header))))
 
+(defun lurk-clear-buffer ()
+  "Completely erase all non-prompt and non-input text from lurk buffer."
+  (with-current-buffer "*lurk*"
+    (let ((inhibit-read-only t))
+      (delete-region (point-min) lurk-prompt-marker))))
 
 ;;; Output formatting and highlighting
 ;;
@@ -441,8 +450,35 @@ portion of the source component of the message, as LURK doesn't use this.")
       (fill-region (point-min) (point-max) nil t)
       (buffer-string))))
 
+(defun lurk--start-of-final-line ()
+  (with-current-buffer "*lurk*"
+    (save-excursion
+      (goto-char (point-max))
+      (line-beginning-position))))
+
+(defun lurk-scroll-windows-to-last-line ()
+  (with-current-buffer "*lurk*"
+    (dolist (window (get-buffer-window-list))
+      (if (>= (window-point window) (lurk--start-of-final-line))
+          (with-selected-window window
+            (recenter -1))))))
+
+(defun lurk-make-context-button (context &optional label)
+  (with-temp-buffer
+    (insert-text-button (or label context)
+                        'action #'lurk--context-button-action
+                        'follow-link t
+                        'help-echo "Switch context.")
+    (buffer-string)))
+
+(defun lurk--context-button-action (button)
+  (let ((context (button-get button 'context)))
+    (if (eq lurk-current-context context)
+        (lurk-toggle-zoom)
+      (lurk-set-current-context context))))
+
 (defun lurk-display-string (context prefix &rest strings)
-  (with-current-buffer (get-buffer-create "*lurk*")
+  (with-current-buffer "*lurk*"
     (save-excursion
       (goto-char lurk-prompt-marker)
       (let* ((inhibit-read-only t)
@@ -469,7 +505,8 @@ portion of the source component of the message, as LURK doesn't use this.")
                        'face (lurk-get-context-facelist context)
                        'read-only t
                        'context context
-                       'invisible context-atom))))))))
+                       'invisible context-atom)))))))
+  (lurk-scroll-windows-to-last-line))
 
 (defun lurk-display-message (from to text)
   (let ((context (if (eq 'channel (lurk-get-context-type to))
@@ -479,8 +516,10 @@ portion of the source component of the message, as LURK doesn't use this.")
      context
      (propertize
       (pcase (lurk-get-context-type to)
-        ('channel (concat to " <" from ">"))
-        ('nick (concat "[" from " -> " to "]"))
+        ('channel (concat
+                   (lurk-make-context-button to)
+                   " <" from ">"))
+        ('nick (lurk-make-context-button context (concat "[" from " -> " to "]")))
         (_
          (error "Unsupported context type")))
       'face (lurk-get-context-facelist context))
@@ -493,7 +532,7 @@ portion of the source component of the message, as LURK doesn't use this.")
     (lurk-display-string
      context
      (propertize
-      (concat context " * " from)
+      (concat (lurk-make-context-button context) " * " from)
       'face (lurk-get-context-facelist context))
      action-text)))
 
@@ -528,7 +567,8 @@ portion of the source component of the message, as LURK doesn't use this.")
                (remove-from-invisibility-spec this-context-atom)
              (add-to-invisibility-spec this-context-atom)))))
      lurk-context-facelists)
-    (force-window-update "*lurk*")))
+    (force-window-update "*lurk*"))
+  (lurk-scroll-windows-to-last-line))
 
 (defun lurk-zoom-out ()
   (with-current-buffer "*lurk*"
@@ -537,7 +577,18 @@ portion of the source component of the message, as LURK doesn't use this.")
        (let ((this-context-atom (if this-context (intern this-context) nil)))
          (remove-from-invisibility-spec this-context-atom)))
      lurk-context-facelists)
-    (force-window-update "*lurk*")))
+    (force-window-update "*lurk*"))
+  (lurk-scroll-windows-to-last-line))
+
+(defun lurk-clear-context (context)
+  (with-current-buffer "*lurk*"
+    (save-excursion
+      (goto-char (point-min))
+      (let ((inhibit-read-only t)
+            (match nil))
+        (while (setq match (text-property-search-forward 'context context t))
+          (delete-region (prop-match-beginning match)
+                         (prop-match-end match)))))))
 
 (defconst lurk-url-regex
   (rx (:
@@ -581,7 +632,8 @@ portion of the source component of the message, as LURK doesn't use this.")
           (strikethrough nil)
           (prev-point (point)))
       (while (re-search-forward (rx (or (any "\x02\x1D\x1F\x1E\x0F")
-                                        (: "\x03" (+ digit) (opt "," (* digit))))) nil t)
+                                        (: "\x03" (+ digit) (opt "," (* digit)))))
+                                nil t)
         (let ((beg (+ (match-beginning 0) 1)))
           (if bold
               (add-face-text-property prev-point beg '(:weight bold)))
@@ -633,15 +685,19 @@ portion of the source component of the message, as LURK doesn't use this.")
        (let* ((params (lurk-msg-params msg))
               (channel (elt params 2))
               (names (split-string (elt params 3))))
-         (lurk-add-context-users channel names)))
+         (if (lurk-context-known-p channel)
+             (lurk-add-context-users channel names)
+           (lurk-display-notice nil "Users in " channel ": " (string-join names " ")))))
 
       ("366" ; ENDOFNAMES
        (let* ((params (lurk-msg-params msg))
               (channel (elt params 1)))
-         (lurk-display-notice
-          channel
-          (lurk--as-string (length (lurk-get-context-users channel)))
-          " users in " channel)))
+         (if (lurk-context-known-p channel)
+             (lurk-display-notice
+              channel
+              (lurk--as-string (length (lurk-get-context-users channel)))
+              " users in " channel)
+           (lurk-display-notice nil "End of " channel " names list."))))
 
       ("331"
        (let* ((params (lurk-msg-params msg))
@@ -824,14 +880,19 @@ 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)
+    ("NETWORKS" "List known IRC networks." lurk-command-networks)
+    ("JOIN" "Join one or more channels." lurk-command-join)
     ("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)
+    ("VERSION" "Request version of another user's client via CTCP." lurk-command-version lurk-nick-completions)
     ("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)
+    ("WHOIS" "Ask server for details of nick." nil lurk-nick-completions)
+    ("USERS" "List nicks of users in current context." lurk-command-users)
     ("MSG" "Send private message to user." lurk-command-msg lurk-nick-completions)
+    ("CLEAR" "Clear buffer text." lurk-command-clear lurk-context-completions)
     ("HELP" "Display help on client commands." lurk-command-help lurk-help-completions))
   "Table of commands explicitly supported by Lurk.")
 
@@ -864,34 +925,6 @@ in which case they match anything.")
       (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)
-      (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-debug (params)
   (setq lurk-debug 
         (if params
@@ -919,9 +952,20 @@ in which case they match anything.")
         (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-join (params)
+  (if params
+      (dolist (channel params)
+        (lurk-send-msg (lurk-msg nil nil "JOIN" channel)))
+    (lurk-display-notice nil "Usage: /join channel [channel2 ...]")))
 
 (defun lurk-command-part (params)
   (let ((channel (if params (car params) lurk-current-context)))
@@ -938,7 +982,7 @@ in which case they match anything.")
     (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)
@@ -946,8 +990,8 @@ in which case they match anything.")
     (if new-nick
         (if (lurk-connected-p)
             (lurk-send-msg (lurk-msg nil nil "NICK" new-nick))
-          (setq lurk-nick nick)
-          (lurk-display-notice nil "Set default nick to '" nick "'."))
+          (setq lurk-nick new-nick)
+          (lurk-display-notice nil "Set default nick to '" lurk-nick "'."))
       (lurk-display-notice nil "Current nick: " lurk-nick))))
 
 (defun lurk-command-me (params)
@@ -976,13 +1020,56 @@ 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>")))
 
+(defun lurk-command-clear (params)
+  (if (not params)
+      (lurk-clear-buffer)
+    (dolist (context params)
+      (lurk-clear-context context))))
+
+(defun lurk-command-users (params)
+  (if lurk-current-context
+      (progn
+        (lurk-display-notice lurk-current-context "Users in " lurk-current-context ":")
+        (lurk-display-notice
+         lurk-current-context
+         (string-join (lurk-get-context-users lurk-current-context) " ")))
+    (lurk-display-notice nil "No current channel.")))
+
+;;; 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 (and command-row (elt command-row 2))
+               (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
 ;;
@@ -990,18 +1077,6 @@ in which case they match anything.")
 (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)
@@ -1016,14 +1091,6 @@ in which case they match anything.")
       (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
 ;;
@@ -1046,22 +1113,31 @@ in which case they match anything.")
     (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))
-    (when (and (>= (point) lurk-input-marker))
+    (when (>= (point) lurk-input-marker)
       (pcase (buffer-substring lurk-input-marker (point))
         ((rx (: "/" (let cmd-str (+ (not whitespace))) (+ " ") (* (not whitespace)) string-end))
          (let ((space-idx (save-excursion
                             (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)
-                               (mapcar (lambda (row) (string-join (list "/" (car row))))
+                               (mapcar (lambda (row) (concat "/" (car row) " "))
                                        lurk-command-table)))
         (_
          (let* ((end (max lurk-input-marker (point)))
@@ -1069,7 +1145,22 @@ in which case they match anything.")
                              (re-search-backward " " lurk-input-marker 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)))))))))
+             (let* ((users (lurk-get-context-users lurk-current-context))
+                    (users-no@ (mapcar
+                                (lambda (u) (car (split-string u "@" t)))
+                                users)))
+               (completion-in-region start end users-no@)))))))))
+
+(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
@@ -1078,33 +1169,38 @@ in which case they match anything.")
 (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)
+    (when (fboundp 'evil-define-key*)
+      (evil-define-key* 'motion map
+        (kbd "TAB") 'lurk-complete-input))
     map))
 
-(defvar lurk-mode-map)
-
 (define-derived-mode lurk-mode text-mode "lurk"
   "Major mode for LURK.")
 
 (when (fboundp 'evil-set-initial-state)
   (evil-set-initial-state 'lurk-mode 'insert))
 
+
 ;;; 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)
-    (lurk-setup-buffer))
+    (lurk-setup-buffer)
+    (if network
+        (lurk-command-connect (list network))))
   "Started LURK.")