emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master 7a69fe3: Merge branch 'feature/rcirc-update'


From: Philip Kaludercic
Subject: master 7a69fe3: Merge branch 'feature/rcirc-update'
Date: Wed, 15 Sep 2021 11:36:28 -0400 (EDT)

branch: master
commit 7a69fe3bc993f2599dacf653b43e4cba72456ac1
Merge: b2e3669 5ebad79
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Merge branch 'feature/rcirc-update'
---
 doc/misc/rcirc.texi |  72 ++++++++-
 etc/NEWS            |  41 ++++-
 lisp/net/rcirc.el   | 452 ++++++++++++++++++++++++++++++++++------------------
 3 files changed, 400 insertions(+), 165 deletions(-)

diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index ae3a3b1..47de523 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -254,6 +254,10 @@ To make this permanent, add the following to your init 
file:
 
 Use @kbd{C-c C-@key{SPC}} to switch to these buffers.
 
+@vindex rcirc-track-ignore-server-buffer-flag
+If the user wishes to ignore events in the server buffer, set
+@code{rcirc-track-ignore-server-buffer-flag} to a non-nil value.
+
 @node Reference
 @chapter Reference
 @cindex reference
@@ -426,7 +430,13 @@ lost.  The simple solution is to use @kbd{M-x rcirc}.  The 
problem is
 that this opens an @emph{additional} connection, so you'll have two
 copies of every channel buffer, one dead and one live.
 
-The real answer, therefore, is the @code{/reconnect} command.
+One option therefore, is the @code{/reconnect} command.
+
+An other approach is to set @code{rcirc-reconnect-delay} to a value
+greater than 0, and allow rcirc to reconnect when it detects that the
+connection has been closed.  By default it will try to do this three
+times (as specified by @code{rcirc-reconnect-attempts}), before giving
+up.
 @end table
 
 @node Useful IRC commands
@@ -671,6 +681,12 @@ window is showing them), the mode line will now show you 
the abbreviated
 channel or nick name.  Use @kbd{C-c C-@key{SPC}} to switch to these
 buffers.
 
+@cindex rcirc-track-abbrevate-flag
+By default the channel names are abbreviated, set
+@code{rcirc-track-abbrevate-flag} to a non-nil value. This might be
+interesting if the IRC activities are not tracked in the mode line,
+but somewhere else.
+
 @vindex rcirc-mode-hook
 If you prefer not to load @code{rcirc} immediately, you can delay the
 activation of this mode:
@@ -807,6 +823,18 @@ active and only omits a message if the nick has not been 
active.  The
 window @code{rcirc} considers is controlled by the
 @code{rcirc-omit-threshold} variable.
 
+@vindex rcirc-omit-responses-after-join
+Right after connecting to a server, rcirc will also hide all messages
+in @code{rcirc-omit-responses-after-join}, next to
+@code{rcirc-omit-responses}. For example,
+
+@example
+(setq rcirc-omit-responses-after-join '("TOPIC" "NICK"))
+@end example
+
+would hide the topic message and the list of users in the current
+channel right after joining a new channel.
+
 @node Hacking and Tweaking
 @chapter Hacking and Tweaking
 @cindex hacking and tweaking
@@ -819,6 +847,7 @@ Here are some examples of stuff you can do to configure 
@code{rcirc}.
 * Scrolling conservatively::
 * Changing the time stamp format::
 * Defining a new command::
+* Using rcirc with bouncers::
 @end menu
 
 @node Skipping /away messages using handlers
@@ -903,22 +932,53 @@ how to include the date in the time stamp:
 @cindex new commands, defining
 
 Here's a simple new command, @code{/sv}.  With it, you can boast about
-your IRC client.  It shows how you can use @code{defun-rcirc-command} to
+your IRC client.  It shows how you can use @code{rcirc-define-command} to
 define new commands.
 
+@findex rcirc-define-command
 We're waiting for the definition of this command until @code{rcirc} is loaded
-because @code{defun-rcirc-command} is not yet available, and without
+because @code{rcirc-define-command} is not yet available, and without
 @code{rcirc} loaded, the command wouldn't do us much good anyway.
 
 @smallexample
 (with-eval-after-load 'rcirc
-  (defun-rcirc-command sv (arg)
+  (rcirc-define-command sv ()
     "Boast about rcirc."
     (interactive "i")
-    (rcirc-send-message process target
-                         (concat "I use " rcirc-id-string))))
+    (rcirc-send-message process target "I use " rcirc-id-string)))
 @end smallexample
 
+@node Using rcirc with bouncers
+@section Using rcirc with bouncers
+@cindex bouncer
+
+Some bouncers multiplex connections to various servers, but have to
+modify nicks and channel names to make this work. The channel
+@code{#emacs} on @code{irc.libera.chat} becomes
+@code{#emacs/irc.libera.chat}.
+
+@vindex rcirc-nick-filter
+@vindex rcirc-channel-filter
+The options @code{rcirc-nick-filter} and @code{rcirc-channel-filter}
+can be used to make this feel more natural. When set to functions,
+these will be used to change how nicks and channel names are
+displayed. A simple configuration to fix the above example might be:
+
+@smallexample
+(defun my/rcirc-remove-suffix (STR)
+  "Remove suffixes from STR."
+  (save-match-data
+    (if (string-match "/[[:alpha:]]+?\\'" str)
+        (substring str 0 (match-beginning 0))
+      str)))
+
+(setq rcirc-nick-filter #'my/rcirc-remove-suffix
+      rcirc-channel-filter #'local/rcirc-soju-suffix)
+@end smallexample
+
+The effect is that buffer names, nicks in messages, nick-completion
+all strip away the suffix introduced by the bouncer.
+
 @node GNU Free Documentation License
 @appendix GNU Free Documentation License
 @include doclicense.texi
diff --git a/etc/NEWS b/etc/NEWS
index 0c9dded..9181557 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2746,6 +2746,44 @@ Variable 'mh-whitelist-preserves-sequences-flag' is 
renamed
 Face 'mh-folder-blacklisted' is renamed 'mh-folder-blocklisted'.
 Face 'mh-folder-whitelisted' is renamed 'mh-folder-allowlisted'.
 
+** Rcirc
+
++++
+*** rcirc now supports SASL authentication.
+
+---
+*** rcirc connects asynchronously
+
+---
+*** Integrate formatting into rcirc-send-string
+The function now accepts a variable number of arguments.
+
++++
+*** Deprecate defun-rcirc-command in favour of rcirc-define-command
+The new macro handles multiple and optional arguments.
+
+---
+*** Add basic IRCv3 support
+This includes support for the capabilities: server-time, batch,
+message-ids, invite-notify, multi-prefix and standard-replies.
+
+---
+*** Add mouse property support to rcirc-track-minor-mode
+
+---
+*** Improve support for IRC markup codes
+
+---
+*** Check auth-sources for server passwords
+
+---
+*** Allow for channels to hide certain message types right after connecting.
+Set rcirc-omit-responses-after-join analogously to rcirc-omit-responses.
+
++++
+*** Implement repeated reconnection strategy
+See rcirc-reconnect-attempts.
+
 ** Miscellaneous
 
 ---
@@ -2766,9 +2804,6 @@ will now restore the original order.
 ---
 *** 'M-left' and 'M-right' now move between columns in 'tabulated-list-mode'.
 
-+++
-*** rcirc now supports SASL authentication.
-
 ---
 *** New variable 'hl-line-overlay-priority'.
 This can be used to change the priority of the hl-line overlays.
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 9d242c4..bc67562 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -60,9 +60,9 @@
 
 (defcustom rcirc-server-alist
   (if (gnutls-available-p)
-      '(("irc.libera.chat" :channels ("#rcirc")
+      '(("irc.libera.chat" :channels ("#emacs" "#rcirc")
          :port 6697 :encryption tls))
-    '(("irc.libera.chat" :channels ("#rcirc"))))
+    '(("irc.libera.chat" :channels ("#emacs" "#rcirc"))))
   "An alist of IRC connections to establish when running `rcirc'.
 Each element looks like (SERVER-NAME PARAMETERS).
 
@@ -194,16 +194,15 @@ If nil, no maximum is applied."
   "Responses which will be hidden when `rcirc-omit-mode' is enabled."
   :type '(repeat string))
 
-(defcustom rcirc-omit-after-reconnect
-  '("JOIN" "TOPIC" "NAMES")
-  "Types of messages to hide right after reconnecting."
+(defcustom rcirc-omit-responses-after-join '()
+  "Types of messages to hide right after joining a channel."
   :type '(repeat string)
   :version "28.1")
 
-(defvar-local rcirc-reconncting nil
-  "Non-nil means we have just reconnected.
+(defvar-local rcirc-joined nil
+  "Non-nil means we have just connected.
 This is used to hide the message types enumerated in
-`rcirc-supress-after-reconnect'.")
+`rcirc-omit-responses-after-join'.")
 
 (defvar-local rcirc-prompt-start-marker nil
   "Marker indicating the beginning of the message prompt.")
@@ -215,11 +214,8 @@ Uninteresting lines are those whose responses are listed in
 `rcirc-omit-responses'."
   :lighter " Omit"
   (if rcirc-omit-mode
-      (progn
-       (add-to-invisibility-spec '(rcirc-omit . nil))
-       (message "Rcirc-Omit mode enabled"))
-    (remove-from-invisibility-spec '(rcirc-omit . nil))
-    (message "Rcirc-Omit mode disabled"))
+      (add-to-invisibility-spec '(rcirc-omit . nil))
+    (remove-from-invisibility-spec '(rcirc-omit . nil)))
   (dolist (window (get-buffer-window-list (current-buffer)))
     (with-selected-window window
       (recenter (when (> (point) rcirc-prompt-start-marker) -1)))))
@@ -413,6 +409,21 @@ will be killed."
   :version "28.1"
   :type 'function)
 
+(defcustom rcirc-channel-filter #'identity
+  "Function applied to channels before displaying."
+  :version "28.1"
+  :type 'function)
+
+(defcustom rcirc-track-ignore-server-buffer-flag nil
+  "Non-nil means activities in the server buffer are not traced."
+  :version "28.1"
+  :type 'boolean)
+
+(defcustom rcirc-display-server-buffer t
+  "Non-nil means the server buffer should be shown on connecting."
+  :version "28.1"
+  :type 'boolean)
+
 (defvar-local rcirc-nick nil
   "The nickname used for the current connection.")
 
@@ -512,10 +523,12 @@ If ARG is non-nil, instead prompt for connection 
parameters."
                                                           :channels)
                                                " "))
                        "[, ]+" t))
-             (encryption (rcirc-prompt-for-encryption server-plist)))
-       (rcirc-connect server port nick user-name
-                      rcirc-default-full-name
-                      channels password encryption))
+             (encryption (rcirc-prompt-for-encryption server-plist))
+             (process (rcirc-connect server port nick user-name
+                                    rcirc-default-full-name
+                                    channels password encryption)))
+       (when rcirc-display-server-buffer
+          (pop-to-buffer-same-window (process-buffer process))))
     ;; connect to servers in `rcirc-server-alist'
     (let (connected-servers)
       (dolist (c rcirc-server-alist)
@@ -544,9 +557,11 @@ If ARG is non-nil, instead prompt for connection 
parameters."
                  (setq connected p)))
              (if (not connected)
                  (condition-case nil
-                     (rcirc-connect server port nick user-name
-                                     full-name channels password encryption
-                                     server-alias)
+                     (let ((process (rcirc-connect server port nick user-name
+                                                    full-name channels 
password encryption
+                                                    server-alias)))
+                        (when rcirc-display-server-buffer
+                          (pop-to-buffer-same-window (process-buffer 
process))))
                    (quit (message "Quit connecting to %s"
                                    (or server-alias server))))
                (with-current-buffer (process-buffer connected)
@@ -595,6 +610,8 @@ FULL-NAME STARTUP-CHANNELS PASSWORD ENCRYPTION 
SERVER-ALIAS).
 See `rcirc-connect' for more details on these variables.")
 (defvar-local rcirc-process nil
   "Network process for the current connection.")
+(defvar-local rcirc-last-connect-time nil
+  "The last time the buffer was connected.")
 
 ;;; IRCv3 capability negotiation 
(https://ircv3.net/specs/extensions/capability-negotiation)
 (defvar rcirc-implemented-capabilities
@@ -604,6 +621,16 @@ See `rcirc-connect' for more details on these variables.")
     "message-ids"                       
;https://ircv3.net/specs/extensions/message-ids
     "invite-notify"                     
;https://ircv3.net/specs/extensions/invite-notify
     "sasl"                              
;https://ircv3.net/specs/extensions/sasl-3.1
+    "multi-prefix"                      
;https://ircv3.net/specs/extensions/multi-prefix
+    "standard-replies"                  
;https://ircv3.net/specs/extensions/standard-replies
+    ;; The following capabilities should be implemented as soon as
+    ;; their specifications are undrafted:
+    ;;
+    ;; "reply"                             
;https://ircv3.net/specs/client-tags/reply
+    ;; "react"                             
;https://ircv3.net/specs/client-tags/react
+    ;; "multiline"                         
;https://ircv3.net/specs/extensions/multiline
+    ;; "chathistory"                       
;https://ircv3.net/specs/extensions/chathistory
+    ;; "channel-rename"                    
;https://ircv3.net/specs/extensions/channel-rename
     )
   "A list of capabilities that rcirc supports.")
 (defvar-local rcirc-requested-capabilities nil
@@ -611,7 +638,7 @@ See `rcirc-connect' for more details on these variables.")
 (defvar-local rcirc-acked-capabilities nil
   "A list of capabilities that the server supports.")
 (defvar-local rcirc-finished-sasl t
-  "Check whether SASL authentication has completed")
+  "Check whether SASL authentication has completed.")
 
 (defun rcirc-get-server-method (server)
   "Return authentication method for SERVER."
@@ -644,69 +671,61 @@ that are joined after authentication."
     (message "Connecting to %s..." (or server-alias server))
     (let* ((inhibit-eol-conversion)
            (port-number (if port
-                           (if (stringp port)
-                               (string-to-number port)
-                             port)
-                         rcirc-default-port))
-          (nick (or nick rcirc-default-nick))
-          (user-name (or user-name rcirc-default-user-name))
-          (full-name (or full-name rcirc-default-full-name))
-          (startup-channels startup-channels)
-           (use-sasl (eq (rcirc-get-server-method server) 'sasl))
-           (process (open-network-stream
+                            (if (stringp port)
+                                (string-to-number port)
+                              port)
+                          rcirc-default-port))
+           (nick (or nick rcirc-default-nick))
+           (user-name (or user-name rcirc-default-user-name))
+           (full-name (or full-name rcirc-default-full-name))
+           (startup-channels startup-channels)
+
+           process)
+
+      ;; Ensure any previous process is killed
+      (when-let ((old-process (get-process (or server-alias server))))
+        (set-process-sentinel old-process #'ignore)
+        (delete-process process))
+
+      ;; Set up process
+      (setq process (open-network-stream
                      (or server-alias server) nil server port-number
-                     :type (or encryption 'plain))))
-      ;; set up process
+                     :type (or encryption 'plain)
+                     :nowait t))
       (set-process-coding-system process 'raw-text 'raw-text)
-      (switch-to-buffer (rcirc-generate-new-buffer-name process nil))
-      (set-process-buffer process (current-buffer))
-      (unless (eq major-mode 'rcirc-mode)
-        (rcirc-mode process nil))
-      (set-process-sentinel process 'rcirc-sentinel)
-      (set-process-filter process 'rcirc-filter)
-
-      (setq rcirc-connection-info
-           (list server port nick user-name full-name startup-channels
-                 password encryption server-alias))
-      (setq rcirc-process process)
-      (setq rcirc-server server)
-      (setq rcirc-server-name (or server-alias server)) ; Update when we get 
001 response.
-      (setq rcirc-nick-table (make-hash-table :test 'equal))
-      (setq rcirc-nick nick)
-      (setq rcirc-startup-channels startup-channels)
-      (setq rcirc-last-server-message-time (current-time))
-
-      (setq rcirc-connecting t)
-
-      (add-hook 'auto-save-hook 'rcirc-log-write)
-      (when use-sasl
-        (rcirc-send-string process "CAP REQ sasl"))
-
-      (when use-sasl
-        (setq-local rcirc-finished-sasl nil))
-      ;; identify
-      (dolist (cap rcirc-implemented-capabilities)
-        (rcirc-send-string process "CAP" "REQ" : cap)
-        (push cap rcirc-requested-capabilities))
-      (unless (zerop (length password))
-        (rcirc-send-string process "PASS" password))
-      (rcirc-send-string process "NICK" nick)
-      (rcirc-send-string process "USER" user-name "0" "*" : full-name)
-      ;; Setup sasl, and initiate authentication.
-      (when (and rcirc-auto-authenticate-flag
-                 use-sasl)
-        (rcirc-send-string process "AUTHENTICATE" "PLAIN"))
-
-      ;; setup ping timer if necessary
-      (unless rcirc-keepalive-timer
-       (setq rcirc-keepalive-timer
-             (run-at-time 0 (/ rcirc-timeout-seconds 2) 'rcirc-keepalive)))
-
-      (message "Connecting to %s...done" (or server-alias server))
-      (setq mode-line-process nil)
-
-      ;; return process object
-      process)))
+      (with-current-buffer (get-buffer-create (rcirc-generate-new-buffer-name 
process nil))
+        (set-process-buffer process (current-buffer))
+        (unless (eq major-mode 'rcirc-mode)
+          (rcirc-mode process nil))
+        (set-process-sentinel process #'rcirc-sentinel)
+        (set-process-filter process #'rcirc-filter)
+
+        (setq rcirc-connection-info
+              (list server port nick user-name full-name startup-channels
+                    password encryption server-alias))
+        (setq rcirc-process process)
+        (setq rcirc-server server)
+        (setq rcirc-server-name (or server-alias server)) ; Update when we get 
001 response.
+        (setq rcirc-nick-table (make-hash-table :test 'equal))
+        (setq rcirc-nick nick)
+        (setq rcirc-startup-channels startup-channels)
+        (setq rcirc-last-server-message-time (current-time))
+        (setq rcirc-last-connect-time (current-time))
+
+        ;; Check if the immediate process state
+        (sit-for .1)
+        (cond
+         ((eq (process-status process) 'failed)
+          (setq mode-line-process ":disconnected")
+          (setq rcirc-connecting nil))
+         ((eq (process-status process) 'connect)
+          (setq mode-line-process ":connecting")
+          (setq rcirc-connecting t)))
+
+        (add-hook 'auto-save-hook #'rcirc-log-write)
+
+        ;; return process object
+        process))))
 
 (defmacro with-rcirc-process-buffer (process &rest body)
   "Evaluate BODY in the buffer of PROCESS."
@@ -795,31 +814,112 @@ When 0, do not auto-reconnect."
   :version "25.1"
   :type 'integer)
 
-(defvar-local rcirc-last-connect-time nil
-  "The last time the buffer was connected.")
+(defcustom rcirc-reconnect-attempts 3
+  "Number of times a reconnection should be attempted."
+  :version "28.1"
+  :type 'integer)
+
+(defvar-local rcirc-failed-attempts 0
+  "Number of times reconnecting has failed.")
+
+(defvar-local rcirc-reconnection-timer nil
+  "Timer used for reconnecting.")
+
+(defun rcirc-reconnect (process &optional quiet)
+  "Attempt to reconnect connection to PROCESS.
+If QUIET is non-nil, no not emit a message."
+  (with-rcirc-process-buffer process
+    (catch 'exit
+      (if (rcirc--connection-open-p process)
+          (throw 'exit (or quiet (message "Server process is alive")))
+        (delete-process process))
+      (let ((conn-info rcirc-connection-info))
+       (setf (nth 5 conn-info)
+             (cl-remove-if-not #'rcirc-channel-p
+                               (mapcar #'car rcirc-buffer-alist)))
+        (dolist (buffer (mapcar #'cdr rcirc-buffer-alist))
+         (when (buffer-live-p buffer)
+            (with-current-buffer buffer
+             (setq mode-line-process ":connecting"))))
+       (let ((nprocess (apply #'rcirc-connect conn-info)))
+          (when (and (< rcirc-failed-attempts rcirc-reconnect-attempts)
+                     (eq (process-status nprocess) 'failed))
+            (setq rcirc-failed-attempts (1+ rcirc-failed-attempts))
+            (rcirc-print nprocess "*rcirc*" "ERROR" nil
+                        (format "Failed to reconnect (%d/%d)..."
+                                 rcirc-failed-attempts
+                                 rcirc-reconnect-attempts))
+            (setq rcirc-reconnection-timer
+                  (run-at-time rcirc-timeout-seconds nil
+                               #'rcirc-reconnect process t))))))))
 
 (defun rcirc-sentinel (process sentinel)
   "Called when PROCESS receives SENTINEL."
   (let ((sentinel (string-replace "\n" "" sentinel)))
     (rcirc-debug process (format "SENTINEL: %S %S\n" process sentinel))
     (with-rcirc-process-buffer process
-      (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
-       (with-current-buffer (or buffer (current-buffer))
-         (rcirc-print process "rcirc.el" "ERROR" rcirc-target
-                      (format "%s: %s (%S)"
-                              (process-name process)
-                              sentinel
-                              (process-status process))
-                       (not rcirc-target))
-         (rcirc-disconnect-buffer)))
-      (when (and (string= sentinel "deleted")
-                 (< 0 rcirc-reconnect-delay))
+      (cond
+       ((string= sentinel "open")
+        (let* ((server (nth 0 rcirc-connection-info))
+               (user-name (nth 3 rcirc-connection-info))
+               (full-name (nth 4 rcirc-connection-info))
+               (password (nth 6 rcirc-connection-info))
+               (server-alias (nth 8 rcirc-connection-info))
+               (use-sasl (eq (rcirc-get-server-method server) 'sasl)))
+
+          ;; Prepare SASL authentication
+          (when use-sasl
+            (rcirc-send-string process "CAP REQ sasl")
+            (setq-local rcirc-finished-sasl nil))
+
+          ;; Capability negotiation
+          (dolist (cap rcirc-implemented-capabilities)
+            (rcirc-send-string process "CAP" "REQ" : cap)
+            (push cap rcirc-requested-capabilities))
+
+          ;; Identify user
+          (unless (zerop (length password))
+            (rcirc-send-string process "PASS" password))
+          (rcirc-send-string process "NICK" rcirc-nick)
+          (rcirc-send-string process "USER" user-name "0" "*" : full-name)
+
+          ;; Setup sasl, and initiate authentication.
+          (when (and rcirc-auto-authenticate-flag
+                     use-sasl)
+            (rcirc-send-string process "AUTHENTICATE" "PLAIN"))
+
+          ;; Setup ping timer if necessary
+          (unless rcirc-keepalive-timer
+            (setq rcirc-keepalive-timer
+                  (run-at-time 0 (/ rcirc-timeout-seconds 2) 
#'rcirc-keepalive)))
+
+          ;; Reset previous reconnection attempts
+          (setq rcirc-failed-attempts 0)
+          (when rcirc-reconnection-timer
+            (cancel-timer rcirc-reconnection-timer)
+            (setq rcirc-reconnection-timer nil))
+
+          (message "Connecting to %s...done" (or server-alias server))
+          (dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
+           (with-current-buffer (or buffer (current-buffer))
+             (setq mode-line-process nil)))))
+       ((string= sentinel "deleted")
         (let ((now (current-time)))
-          (when (or (null rcirc-last-connect-time)
-                   (time-less-p rcirc-reconnect-delay
-                                (time-subtract now rcirc-last-connect-time)))
-            (setq rcirc-last-connect-time now)
-            (rcirc-cmd-reconnect nil))))
+          (with-rcirc-process-buffer process
+            (when (and (< 0 rcirc-reconnect-delay)
+                       (time-less-p rcirc-reconnect-delay
+                                   (time-subtract now 
rcirc-last-connect-time)))
+              (setq rcirc-last-connect-time now)
+              (rcirc-reconnect process)))))
+       ((dolist (buffer (cons nil (mapcar 'cdr rcirc-buffer-alist)))
+         (with-current-buffer (or buffer (current-buffer))
+           (rcirc-print process "*rcirc*" "ERROR" rcirc-target
+                        (format "%s: %s (%S)"
+                                (process-name process)
+                                sentinel
+                                (process-status process))
+                         (not rcirc-target))
+           (rcirc-disconnect-buffer)))))
       (run-hook-with-args 'rcirc-sentinel-functions process sentinel))))
 
 (defun rcirc-disconnect-buffer (&optional buffer)
@@ -879,7 +979,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and 
LINE.")
       (condition-case err
           (rcirc-process-server-response-1 process text)
         (error
-         (rcirc-print process "RCIRC" "ERROR" nil
+         (rcirc-print process "*rcirc*" "ERROR" nil
                       (format "\"%s\" %s" text err) t)))
     (rcirc-process-server-response-1 process text)))
 
@@ -1054,7 +1154,7 @@ With no argument or nil as argument, use the current 
buffer."
   (let ((buffer (or buffer (and (buffer-live-p rcirc-server-buffer)
                                rcirc-server-buffer))))
     (if buffer
-        (with-current-buffer buffer rcirc-process)
+        (buffer-local-value 'rcirc-process buffer)
       rcirc-process)))
 
 (defun rcirc-server-name (process)
@@ -1258,7 +1358,8 @@ Each element looks like (FILENAME . TEXT).")
 This number is independent of the number of lines in the buffer.")
 
 (defun rcirc-mode (process target)
-  "Major mode for IRC channel buffers.
+  "Initialize an IRC buffer for writing with TARGET.
+PROCESS is the process object used for communication.
 
 \\{rcirc-mode-map}"
   ;; FIXME: Use define-derived-mode.
@@ -1281,7 +1382,6 @@ This number is independent of the number of lines in the 
buffer.")
   (setq rcirc-last-post-time (current-time))
   (setq-local fill-paragraph-function 'rcirc-fill-paragraph)
   (setq rcirc-current-line 0)
-  (setq rcirc-last-connect-time (current-time))
 
   (use-hard-newlines t)
 
@@ -1320,8 +1420,7 @@ This number is independent of the number of lines in the 
buffer.")
   (when target                         ; skip server buffer
     (let ((buffer (current-buffer)))
       (with-rcirc-process-buffer process
-       (setq rcirc-buffer-alist (cons (cons target buffer)
-                                      rcirc-buffer-alist))))
+        (push (cons target buffer) rcirc-buffer-alist)))
     (rcirc-update-short-buffer-names))
 
   (add-hook 'completion-at-point-functions
@@ -1464,10 +1563,11 @@ Create the buffer if it doesn't exist."
                           (rcirc-generate-new-buffer-name process target))))
          (with-current-buffer new-buffer
             (unless (eq major-mode 'rcirc-mode)
-             (rcirc-mode process target)))
+             (rcirc-mode process target))
             (setq mode-line-process nil)
-           (rcirc-put-nick-channel process (rcirc-nick process) target
-                                   rcirc-current-line)
+            (setq rcirc-joined (current-time)))
+         (rcirc-put-nick-channel process (rcirc-nick process) target
+                                 rcirc-current-line)
          new-buffer)))))
 
 (defun rcirc-send-input ()
@@ -1522,6 +1622,11 @@ The argument JUSTIFY is passed on to `fill-region'."
 
 (defun rcirc-process-message (line)
   "Process LINE as a message to be sent."
+  (when (and (null rcirc-target)
+             (string-match
+              (rx bos (group (+? nonl)) "@" (+ nonl) eos)
+              (buffer-name)))
+    (setq rcirc-target (match-string 1 (buffer-name))))
   (if (not rcirc-target)
       (message "Not joined (no target)")
     (delete-region rcirc-prompt-end-marker (point))
@@ -1625,6 +1730,9 @@ extracted."
     ("ACTION"  . "[%N %m]")
     ("COMMAND" . "%m")
     ("ERROR"   . "%fw!!! %m")
+    ("FAIL"   . "(%fwFAIL%f-) %m")
+    ("WARN"   . "(%fwWARN%f-) %m")
+    ("NOTE"   . "(%fwNOTE%f-) %m")
     (t         . "%fp*** %fs%n %r %m"))
   "An alist of formats used for printing responses.
 The format is looked up using the response-type as a key;
@@ -1742,8 +1850,9 @@ Returns nil if the information is not recorded.
 PROCESS is the process object for the current connection."
   (let ((chanbuf (rcirc-get-buffer process target)))
     (when chanbuf
-      (cdr (assoc-string nick (with-current-buffer chanbuf
-                               rcirc-recent-quit-alist))))))
+      (cdr (assoc-string nick (buffer-local-value
+                               'rcirc-recent-quit-alist
+                               chanbuf))))))
 
 (defun rcirc-last-line (process nick target)
   "Return the line from the last activity from NICK in TARGET.
@@ -1858,9 +1967,9 @@ connection."
              (let ((last-activity-lines (rcirc-elapsed-lines process sender 
target)))
                (if (and (not (string= (rcirc-nick process) sender))
                         (or (member response rcirc-omit-responses)
-                             (if (member response rcirc-omit-after-reconnect)
-                                 rcirc-reconncting
-                               (setq rcirc-reconncting nil)))
+                             (and (member response 
rcirc-omit-responses-after-join)
+                                  (< (time-to-seconds (time-since 
rcirc-joined))
+                                     1)))
                         (or (not last-activity-lines)
                             (< rcirc-omit-threshold last-activity-lines)))
                   (put-text-property (point-min) (point-max)
@@ -2008,7 +2117,8 @@ PROCESS is the process object for the current connection."
   "Return the nick from USER.  Remove any non-nick junk."
   (save-match-data
     (if (string-match (concat "^[" rcirc-nick-prefix-chars
-                             "]?\\([^! ]+\\)!?") (or user ""))
+                             "]*\\([^! ]+\\)!?")
+                      (or user ""))
        (match-string 1 user)
       user)))
 
@@ -2119,6 +2229,11 @@ This function does not alter the INPUT string."
     map)
   "Keymap for rcirc track minor mode.")
 
+(defcustom rcirc-track-abbrevate-flag t
+  "Non-nil means `rcirc-track-minor-mode' should abbreviate names."
+  :version "28.1"
+  :type 'boolean)
+
 ;;;###autoload
 (define-minor-mode rcirc-track-minor-mode
   "Global minor mode for tracking activity in rcirc buffers."
@@ -2176,7 +2291,7 @@ This function does not alter the INPUT string."
   "Bury all RCIRC buffers."
   (interactive)
   (dolist (buf (buffer-list))
-    (when (eq 'rcirc-mode (with-current-buffer buf major-mode))
+    (when (eq 'rcirc-mode (buffer-local-value 'major-mode buf))
       (bury-buffer buf)         ; buffers not shown
       (quit-windows-on buf))))  ; buffers shown in a window
 
@@ -2216,13 +2331,15 @@ activity.  Only run if the buffer is not visible and
   (with-current-buffer buffer
     (let ((old-activity rcirc-activity)
          (old-types rcirc-activity-types))
-      (when (not (get-buffer-window (current-buffer) t))
+      (when (and (not (get-buffer-window (current-buffer) t))
+                 (not (and rcirc-track-ignore-server-buffer-flag
+                           (eq rcirc-server-buffer (current-buffer)))))
        (setq rcirc-activity
              (sort (if (memq (current-buffer) rcirc-activity) rcirc-activity
                       (cons (current-buffer) rcirc-activity))
                    (lambda (b1 b2)
-                     (let ((t1 (with-current-buffer b1 rcirc-last-post-time))
-                           (t2 (with-current-buffer b2 rcirc-last-post-time)))
+                     (let ((t1 (buffer-local-value 'rcirc-last-post-time b1))
+                           (t2 (buffer-local-value 'rcirc-last-post-time b2)))
                        (time-less-p t2 t1)))))
        (cl-pushnew type rcirc-activity-types)
        (unless (and (equal rcirc-activity old-activity)
@@ -2299,7 +2416,12 @@ activity.  Only run if the buffer is not visible and
 (defun rcirc-short-buffer-name (buffer)
   "Return a short name for BUFFER to use in the mode line indicator."
   (with-current-buffer buffer
-    (or rcirc-short-buffer-name (buffer-name))))
+    (funcall rcirc-channel-filter
+             (replace-regexp-in-string
+              "@.*?\\'" ""
+              (or (and rcirc-track-abbrevate-flag
+                       rcirc-short-buffer-name)
+                  (buffer-name))))))
 
 (defun rcirc-visible-buffers ()
   "Return a list of the visible buffers that are in `rcirc-mode'."
@@ -2408,7 +2530,7 @@ prefix with another element in PAIRS."
            (when (and (listp x) (listp (cadr x)))
              (setcdr x (if (> (length (cdr x)) 1)
                            (rcirc-make-trees (cdr x))
-                          (setcdr x (list (cdadr x)))))))
+                         (setcdr x (list (cdadr x)))))))
          alist)))
 
 ;;; /commands these are called with 3 args: PROCESS, TARGET, which is
@@ -2441,23 +2563,23 @@ that, an interactive form can specified."
                    (insert "\\(.*?\\)")
                    (insert "[[:space:]]*\\'")
                    (buffer-string)))
-         (argument (gensym))
+         (argument (make-symbol "arglist"))
          documentation
          interactive-spec)
     (when (stringp (car body))
       (setq documentation (pop body)))
     (when (eq (car-safe (car-safe body)) 'interactive)
-      (setq interactive-spec (cdr (pop body))))
+      (setq interactive-spec (cadr (pop body))))
     `(progn
        (defun ,fn-name (,argument &optional process target)
          ,(concat documentation
                   "\n\nNote: If PROCESS or TARGET are nil, the values given"
                  "\nby `rcirc-buffer-process' and `rcirc-target' will be 
used.")
-         (interactive (list ,@interactive-spec))
+         (interactive ,interactive-spec)
          (unless (if (listp ,argument)
                      (<= ,required (length ,argument) ,total)
                    (string-match ,regexp ,argument))
-           (user-error "Malformed input (%s): %S" ',command ',argument))
+           (user-error "Malformed input (%s): %S" ',command ,argument))
          (let ((process (or process (rcirc-buffer-process)))
               (target (or target rcirc-target)))
            (ignore target process)
@@ -2533,18 +2655,8 @@ to `rcirc-default-part-reason'."
 (rcirc-define-command reconnect ()
   "Reconnect to current server."
   (interactive "i")
-  (with-rcirc-server-buffer
-    (cond
-     (rcirc-connecting (message "Already connecting"))
-     ((process-live-p process) (message "Server process is alive"))
-     (t (let ((conn-info rcirc-connection-info))
-         (setf (nth 5 conn-info)
-               (cl-remove-if-not #'rcirc-channel-p
-                                 (mapcar #'car rcirc-buffer-alist)))
-          (dolist (buf (nth 5 conn-info))
-            (with-current-buffer (cdr (assoc buf rcirc-buffer-alist))
-              (setq rcirc-reconncting t)))
-         (apply #'rcirc-connect conn-info))))))
+  (setq rcirc-failed-attempts 0)
+  (rcirc-reconnect process))
 
 (rcirc-define-command nick (nick)
   "Change nick to NICK."
@@ -2564,8 +2676,8 @@ With a prefix arg, prompt for new topic."
   (interactive (list (and current-prefix-arg
                           (read-string "List names in channel: "))))
   (if (> (length topic) 0)
-      (rcirc-send-string process "TOPIC" : topic)
-    (rcirc-send-string process "TOPIC")))
+      (rcirc-send-string process "TOPIC" target : topic)
+    (rcirc-send-string process "TOPIC" target)))
 
 (rcirc-define-command whois (nick)
   "Request information from server about NICK."
@@ -3046,11 +3158,11 @@ connection."
       ;; already open buffer (after getting kicked e.g.)
       (setq mode-line-process nil))
 
-    (rcirc-print process sender "JOIN" channel "")
+    (rcirc-print process sender "JOIN" (funcall rcirc-channel-filter channel) 
"")
 
     ;; print in private chat buffer if it exists
     (when (rcirc-get-buffer (rcirc-buffer-process) sender)
-      (rcirc-print process sender "JOIN" sender channel))))
+      (rcirc-print process sender "JOIN" sender (funcall rcirc-channel-filter 
channel)))))
 
 ;; PART and KICK are handled the same way
 (defun rcirc-handler-PART-or-KICK (process _response channel _sender nick 
_args)
@@ -3079,10 +3191,10 @@ PROCESS is the process object for the current 
connection."
   (let* ((channel (car args))
         (reason (cadr args))
         (message (concat channel " " reason)))
-    (rcirc-print process sender "PART" channel message)
+    (rcirc-print process sender "PART" (funcall rcirc-channel-filter channel) 
message)
     ;; print in private chat buffer if it exists
     (when (rcirc-get-buffer (rcirc-buffer-process) sender)
-      (rcirc-print process sender "PART" sender message))
+      (rcirc-print process sender "PART" (funcall rcirc-channel-filter 
channel) message))
 
     (rcirc-handler-PART-or-KICK process "PART" channel sender sender reason)))
 
@@ -3094,7 +3206,7 @@ PROCESS is the process object for the current connection."
         (nick (cadr args))
         (reason (nth 2 args))
         (message (concat nick " " channel " " reason)))
-    (rcirc-print process sender "KICK" channel message t)
+    (rcirc-print process sender "KICK" (funcall rcirc-channel-filter channel) 
message t)
     ;; print in private chat buffer if it exists
     (when (rcirc-get-buffer (rcirc-buffer-process) nick)
       (rcirc-print process sender "KICK" nick message))
@@ -3124,7 +3236,7 @@ PROCESS is the process object for the current connection."
   (rcirc-ignore-update-automatic sender)
   (mapc (lambda (channel)
          ;; broadcast quit message each channel
-         (rcirc-print process sender "QUIT" channel (apply 'concat args))
+         (rcirc-print process sender "QUIT" (funcall rcirc-channel-filter 
channel) (apply 'concat args))
          ;; record nick in quit table if they recently spoke
          (rcirc-maybe-remember-nick-quit process sender channel))
        (rcirc-nick-channels process sender))
@@ -3145,13 +3257,16 @@ PROCESS is the process object for the current 
connection."
     ;; print message to nick's channels
     (dolist (target channels)
       (rcirc-print process sender "NICK" target new-nick))
-    ;; update private chat buffer, if it exists
-    (let ((chat-buffer (rcirc-get-buffer process old-nick)))
-      (when chat-buffer
-       (with-current-buffer chat-buffer
-         (rcirc-print process sender "NICK" old-nick new-nick)
-         (setq rcirc-target new-nick)
-         (rename-buffer (rcirc-generate-new-buffer-name process new-nick)))))
+    ;; update chat buffer, if it exists
+    (when-let ((chat-buffer (rcirc-get-buffer process old-nick)))
+      (with-current-buffer chat-buffer
+       (rcirc-print process sender "NICK" old-nick new-nick)
+       (setq rcirc-target new-nick)
+       (rename-buffer (rcirc-generate-new-buffer-name process new-nick)))
+      (setf rcirc-buffer-alist
+            (cons (cons new-nick chat-buffer)
+                  (delq (assoc-string old-nick rcirc-buffer-alist t)
+                        rcirc-buffer-alist))))
     ;; remove old nick and add new one
     (with-rcirc-process-buffer process
       (let ((v (gethash old-nick rcirc-nick-table)))
@@ -3234,7 +3349,7 @@ RFC1459."
     (with-current-buffer buffer
       (let ((setter (nth 2 args))
            (time (current-time-string
-                   (string-to-number (cadddr args)))))
+                  (string-to-number (cadddr args)))))
        (rcirc-print process sender "TOPIC" (cadr args)
                     (format "%s (%s on %s)" rcirc-topic setter time))))))
 
@@ -3344,7 +3459,7 @@ Passwords are stored in `rcirc-authinfo' (which see)."
            (server (car i))
            (nick (nth 2 i))
            (method (cadr i))
-            (args (cdddr i)))
+           (args (cdddr i)))
        (when (and (string-match server rcirc-server))
           (if (and (memq method '(nickserv chanserv bitlbee))
                    (string-match nick rcirc-nick))
@@ -3381,6 +3496,8 @@ process object for the current connection."
   (let ((self (buffer-local-value 'rcirc-nick rcirc-process))
         (target (car args))
         (chan (cadr args)))
+    ;; `rcirc-channel-filter' is not used here because joining
+    ;; requires an unfiltered name.
     (if (string= target self)
         (rcirc-print process sender "INVITE" nil
                      (format "%s invited you to %s"
@@ -3451,7 +3568,7 @@ is the process object for the current connection."
     (let ((subcmd (cadr args)))
       (dolist (cap (cddr args))
         (cond ((string= subcmd "ACK")
-               (push cap rcirc-acked-capabilities)
+               (push (intern (downcase cap)) rcirc-acked-capabilities)
                (setq rcirc-requested-capabilities
                      (delete cap rcirc-requested-capabilities)))
               ((string= subcmd "NAK")
@@ -3525,13 +3642,36 @@ PROCESS is the process object for the current 
connection."
             "\0" (rcirc-get-server-password rcirc-server)))))
 
 (defun rcirc-handler-900 (process sender args _text)
-  "Respond to a successful authentication response."
+  "Respond to a successful authentication response.
+SENDER is passed on to `rcirc-handler-generic'.  PROCESS is the
+process object for the current connection."
   (rcirc-handler-generic process "900" sender args nil)
   (when (not rcirc-finished-sasl)
     (setq-local rcirc-finished-sasl t)
     (rcirc-send-string process "CAP" "END"))
   (rcirc-join-channels-post-auth process))
 
+(defun rcirc-handler-FAIL (process _sender args _text)
+  "Display a FAIL message, as indicated by ARGS.
+PROCESS is the process object for the current connection."
+  (rcirc-print process nil "FAIL" nil
+               (mapconcat #'identity args " ")
+               t))
+
+(defun rcirc-handler-WARN (process _sender args _text)
+  "Display a WARN message, as indicated by ARGS.
+PROCESS is the process object for the current connection."
+  (rcirc-print process nil "WARN" nil
+               (mapconcat #'identity args " ")
+               t))
+
+(defun rcirc-handler-NOTE (process _sender args _text)
+  "Display a NOTE message, as indicated by ARGS.
+PROCESS is the process object for the current connection."
+  (rcirc-print process nil "NOTE" nil
+               (mapconcat #'identity args " ")
+               t))
+
 
 (defgroup rcirc-faces nil
   "Faces for rcirc."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]