Initializer can now immediately connect to chosen network.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index 2a95e48..bd1e416 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)
                          "")
                        '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)))


@@ -810,48 +819,52 @@ 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)
+    ("HELP" "Display help on client commands." lurk-command-help lurk-help-completions))

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

+(defun lurk-boolean-completions ()
+  '("on" "off"))

 
 

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

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


@@ -937,27 +950,48 @@ 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))
         (lurk-display-message lurk-nick to text))
     (lurk-display-notice nil "Usage: /msg <nick> <message>")))
 
       (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>")))
 

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

 
 

+;;; Command entering
+;;

 
 

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

 
 (defvar lurk-history-index nil)
 
 
 (defvar lurk-history-index nil)
 


@@ -973,13 +1007,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
 ;;


@@ -1002,31 +1029,52 @@ 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))
     (when (and (>= (point) lurk-input-marker))
       (pcase (buffer-substring lurk-input-marker (point))
 (defun lurk-complete-input ()
   (interactive)
   (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-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)
         ((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)))
                                        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)))))))))
 
            (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
 ;;


@@ -1050,17 +1098,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.")