bug#6076: 23.1.96; [PATCH] rcirc-complete for nicks and commands

[Leo]

On 2010-09-04 09:24 +0100, Stefan Monnier wrote:
>> I reviewed Leo's updated patch at 
>> http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6076#47
>> I agree with Leo, we should install this patch and then look into
>> improvements using completion in region.
>
> I mostly agree, but I think the patch should first be restructured into
> one or 2 functions suitable for completion-at-point-functions
> (i.e. either one that provides the completion data for nicks and
> commands, or one for nicks and one for commands), and then an
> rcirc-complete command that uses these functions to do the completion
> with the desired UI.
>
> I.e. basically a refactoring of rcirc-complete such that it uses the
> same interface between the completion data and the completion UI as the
> one used by completion-at-point.
>
> Then users can choose to use rcirc-complete or completion-at-point, and
> when/if completion-at-point (i.e. completion-in-region) gets to the
> point of being able to provide the same behavior as rcirc-complete, then
> we can get rid of rcirc-complete.
>
>
>         Stefan

Thanks, Stefan, for the comments.

I have recreated the patch against emacs-23 as suggested. I have also
briefly tested it. Seems to work as expected. M-TAB in rcirc-mode now
uses the new completion at point interface.

BTW, I just realise the macro defun-rcirc-command is better named
define-rcirc-command.

2010-09-04  Leo <sdl.web@gmail.com>

        * net/rcirc.el (rcirc-server-commands, rcirc-client-commands)
        (rcirc-completion-start): new variables.
        (rcirc-nick-completions): rename to rcirc-completions.
        (rcirc-nick-completion-start-offset): delete.
        (rcirc-completion-at-point): new function for constructing
        completion data for both nicks and irc commands. Add to
        completion-at-point-functions in rcirc mode.
        (rcirc-complete): use rcirc-completion-at-point.
        (defun-rcirc-command): update rcirc-client-commands.

diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index ec67c3e..cade679 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -771,42 +771,63 @@ If SILENT is non-nil, do not print the message in any irc 
buffer."
     (setq rcirc-input-ring-index (1- rcirc-input-ring-index))
     (insert (rcirc-prev-input-string -1))))
 
-(defvar rcirc-nick-completions nil)
-(defvar rcirc-nick-completion-start-offset nil)
-
-(defun rcirc-complete-nick ()
-  "Cycle through nick completions from list of nicks in channel."
+(defvar rcirc-server-commands
+  '("/admin"   "/away"   "/connect" "/die"      "/error"   "/info"
+    "/invite"  "/ison"   "/join"    "/kick"     "/kill"    "/links"
+    "/list"    "/lusers" "/mode"    "/motd"     "/names"   "/nick"
+    "/notice"  "/oper"   "/part"    "/pass"     "/ping"    "/pong"
+    "/privmsg" "/quit"   "/rehash"  "/restart"  "/service" "/servlist"
+    "/server"  "/squery" "/squit"   "/stats"    "/summon"  "/time"
+    "/topic"   "/trace"  "/user"    "/userhost" "/users"   "/version"
+    "/wallops" "/who"    "/whois"   "/whowas")
+  "A list of user commands by IRC server.
+The value defaults to RFCs 1459 and 2812.")
+
+;; /me and /ctcp are not defined by `defun-rcirc-command'.
+(defvar rcirc-client-commands '("/me" "/ctcp")
+  "A list of user commands defined by IRC client rcirc.
+The list is updated automatically by `defun-rcirc-command'.")
+
+(defun rcirc-completion-at-point ()
+  "Function used for `completion-at-point-functions' in `rcirc-mode'."
+  (let* ((beg (save-excursion
+               (if (re-search-backward " " rcirc-prompt-end-marker t)
+                   (1+ (point))
+                 rcirc-prompt-end-marker)))
+        (table (if (and (eq beg rcirc-prompt-end-marker)
+                        (eq (char-after beg) ?/))
+                   (delete-dups
+                    (append (sort (copy-sequence rcirc-client-commands) 
'string-lessp)
+                            (sort (copy-sequence rcirc-server-commands) 
'string-lessp)))
+                 (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target))))
+    (list beg (point) table)))
+
+(defvar rcirc-completions nil)
+(defvar rcirc-completion-start nil)
+
+(defun rcirc-complete ()
+  "Cycle through completions from list of nicks in channel or IRC commands.
+IRC command completion is performed only if '/' is the first input char."
   (interactive)
   (if (eq last-command this-command)
-      (setq rcirc-nick-completions
-            (append (cdr rcirc-nick-completions)
-                    (list (car rcirc-nick-completions))))
-    (setq rcirc-nick-completion-start-offset
-          (- (save-excursion
-               (if (re-search-backward " " rcirc-prompt-end-marker t)
-                   (1+ (point))
-                 rcirc-prompt-end-marker))
-             rcirc-prompt-end-marker))
-    (setq rcirc-nick-completions
-          (let ((completion-ignore-case t))
-            (all-completions
-            (buffer-substring
-             (+ rcirc-prompt-end-marker
-                rcirc-nick-completion-start-offset)
-             (point))
-            (mapcar (lambda (x) (cons x nil))
-                    (rcirc-channel-nicks (rcirc-buffer-process)
-                                         rcirc-target))))))
-  (let ((completion (car rcirc-nick-completions)))
+      (setq rcirc-completions
+           (append (cdr rcirc-completions) (list (car rcirc-completions))))
+    (let ((completion-ignore-case t)
+         (table (rcirc-completion-at-point)))
+      (setq rcirc-completion-start (car table))
+      (setq rcirc-completions
+           (all-completions (buffer-substring rcirc-completion-start
+                                              (cadr table))
+                            (nth 2 table)))))
+  (let ((completion (car rcirc-completions)))
     (when completion
-      (delete-region (+ rcirc-prompt-end-marker
-                       rcirc-nick-completion-start-offset)
-                    (point))
-      (insert (concat completion
-                      (if (= (+ rcirc-prompt-end-marker
-                                rcirc-nick-completion-start-offset)
-                             rcirc-prompt-end-marker)
-                          ": "))))))
+      (delete-region rcirc-completion-start (point))
+      (insert
+       (concat completion
+              (cond
+               ((= (aref completion 0) ?/) " ")
+               ((= rcirc-completion-start rcirc-prompt-end-marker) ": ")
+               (t "")))))))
 
 (defun set-rcirc-decode-coding-system (coding-system)
   "Set the decode coding system used in this channel."
@@ -824,7 +845,7 @@ If SILENT is non-nil, do not print the message in any irc 
buffer."
 (define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input)
 (define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input)
 (define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input)
-(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick)
+(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete)
 (define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url)
 (define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline)
 (define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join)
@@ -944,6 +965,9 @@ This number is independent of the number of lines in the 
buffer.")
                                       rcirc-buffer-alist))))
     (rcirc-update-short-buffer-names))
 
+  (add-hook 'completion-at-point-functions
+            'rcirc-completion-at-point nil 'local)
+
   (run-hooks 'rcirc-mode-hook))
 
 (defun rcirc-update-prompt (&optional all)
@@ -1962,16 +1986,18 @@ activity.  Only run if the buffer is not visible and
 ;; containing the text following the /cmd.
 
 (defmacro defun-rcirc-command (command argument docstring interactive-form
-                                       &rest body)
+                                      &rest body)
   "Define a command."
-  `(defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
-     (,@argument &optional process target)
-     ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values 
given"
-              "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
-     ,interactive-form
-     (let ((process (or process (rcirc-buffer-process)))
-           (target (or target rcirc-target)))
-       ,@body)))
+  `(progn
+     (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))
+     (defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
+       (,@argument &optional process target)
+       ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values 
given"
+               "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
+       ,interactive-form
+       (let ((process (or process (rcirc-buffer-process)))
+            (target (or target rcirc-target)))
+        ,@body))))
 
 (defun-rcirc-command msg (message)
   "Send private MESSAGE to TARGET."

Regards,
Leo