diff options
Diffstat (limited to 'lisp/erc/erc.el')
| -rw-r--r-- | lisp/erc/erc.el | 289 |
1 files changed, 157 insertions, 132 deletions
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index feee89d7fea..f5c9decc3a2 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -62,17 +62,17 @@ ;;; History: ;; -(defconst erc-version-string (format "\C-bERC\C-b (IRC client for Emacs %s)" emacs-version) - "ERC version. This is used by function `erc-version'.") - ;;; Code: +(load "erc-loaddefs" nil t) + (eval-when-compile (require 'cl-lib)) (require 'font-lock) (require 'pp) (require 'thingatpt) (require 'auth-source) (require 'erc-compat) +(eval-when-compile (require 'subr-x)) (defvar erc-official-location "https://www.emacswiki.org/emacs/ERC (mailing list: erc-discuss@gnu.org)" @@ -399,25 +399,28 @@ If no server buffer exists, return nil." ;; This is useful for ordered name completion. (last-message-time nil)) -(defsubst erc-get-channel-user (nick) +(define-inline erc-get-channel-user (nick) "Find the (USER . CHANNEL-DATA) element corresponding to NICK in the current buffer's `erc-channel-users' hash table." - (gethash (erc-downcase nick) erc-channel-users)) + (inline-quote (gethash (erc-downcase ,nick) erc-channel-users))) -(defsubst erc-get-server-user (nick) +(define-inline erc-get-server-user (nick) "Find the USER corresponding to NICK in the current server's `erc-server-users' hash table." - (erc-with-server-buffer - (gethash (erc-downcase nick) erc-server-users))) + (inline-letevals (nick) + (inline-quote (erc-with-server-buffer + (gethash (erc-downcase ,nick) erc-server-users))))) -(defsubst erc-add-server-user (nick user) +(define-inline erc-add-server-user (nick user) "This function is for internal use only. Adds USER with nickname NICK to the `erc-server-users' hash table." - (erc-with-server-buffer - (puthash (erc-downcase nick) user erc-server-users))) + (inline-letevals (nick user) + (inline-quote + (erc-with-server-buffer + (puthash (erc-downcase ,nick) ,user erc-server-users))))) -(defsubst erc-remove-server-user (nick) +(define-inline erc-remove-server-user (nick) "This function is for internal use only. Removes the user with nickname NICK from the `erc-server-users' @@ -425,8 +428,10 @@ hash table. This user is not removed from the `erc-channel-users' lists of other buffers. See also: `erc-remove-user'." - (erc-with-server-buffer - (remhash (erc-downcase nick) erc-server-users))) + (inline-letevals (nick) + (inline-quote + (erc-with-server-buffer + (remhash (erc-downcase ,nick) erc-server-users))))) (defun erc-change-user-nickname (user new-nick) "This function is for internal use only. @@ -497,45 +502,55 @@ Removes all users in the current channel. This is called by erc-channel-users) (clrhash erc-channel-users))) -(defsubst erc-channel-user-owner-p (nick) +(define-inline erc-channel-user-owner-p (nick) "Return non-nil if NICK is an owner of the current channel." - (and nick - (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user nick))) - (and cdata (cdr cdata) - (erc-channel-user-owner (cdr cdata)))))) - -(defsubst erc-channel-user-admin-p (nick) + (inline-letevals (nick) + (inline-quote + (and ,nick + (hash-table-p erc-channel-users) + (let ((cdata (erc-get-channel-user ,nick))) + (and cdata (cdr cdata) + (erc-channel-user-owner (cdr cdata)))))))) + +(define-inline erc-channel-user-admin-p (nick) "Return non-nil if NICK is an admin in the current channel." - (and nick + (inline-letevals (nick) + (inline-quote + (and ,nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user nick))) + (let ((cdata (erc-get-channel-user ,nick))) (and cdata (cdr cdata) - (erc-channel-user-admin (cdr cdata)))))) + (erc-channel-user-admin (cdr cdata)))))))) -(defsubst erc-channel-user-op-p (nick) +(define-inline erc-channel-user-op-p (nick) "Return non-nil if NICK is an operator in the current channel." - (and nick + (inline-letevals (nick) + (inline-quote + (and ,nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user nick))) + (let ((cdata (erc-get-channel-user ,nick))) (and cdata (cdr cdata) - (erc-channel-user-op (cdr cdata)))))) + (erc-channel-user-op (cdr cdata)))))))) -(defsubst erc-channel-user-halfop-p (nick) +(define-inline erc-channel-user-halfop-p (nick) "Return non-nil if NICK is a half-operator in the current channel." - (and nick + (inline-letevals (nick) + (inline-quote + (and ,nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user nick))) + (let ((cdata (erc-get-channel-user ,nick))) (and cdata (cdr cdata) - (erc-channel-user-halfop (cdr cdata)))))) + (erc-channel-user-halfop (cdr cdata)))))))) -(defsubst erc-channel-user-voice-p (nick) +(define-inline erc-channel-user-voice-p (nick) "Return non-nil if NICK has voice in the current channel." - (and nick + (inline-letevals (nick) + (inline-quote + (and ,nick (hash-table-p erc-channel-users) - (let ((cdata (erc-get-channel-user nick))) + (let ((cdata (erc-get-channel-user ,nick))) (and cdata (cdr cdata) - (erc-channel-user-voice (cdr cdata)))))) + (erc-channel-user-voice (cdr cdata)))))))) (defun erc-get-channel-user-list () "Return a list of users in the current channel. Each element @@ -1036,6 +1051,21 @@ Note that it's useless to set `erc-send-this' to nil and anyway." :group 'erc-hooks :type 'hook) +(make-obsolete-variable 'erc-send-pre-hook 'erc-pre-send-functions "27.1") + +(defcustom erc-pre-send-functions nil + "List of functions called to possibly alter the string that is sent. +The functions are called with one argument, a `erc-input' struct, +and should alter that struct. + +The struct has three slots: + + `string': The current input string. + `insertp': Whether the string should be inserted into the erc buffer. + `sendp': Whether the string should be sent to the irc server." + :group 'erc + :type '(repeat function) + :version "27.1") (defvar erc-insert-this t "Insert the text into the target buffer or not. @@ -1046,6 +1076,7 @@ if they wish to avoid insertion of a particular string.") "Send the text to the target or not. Functions on `erc-send-pre-hook' can set this variable to nil if they wish to avoid sending of a particular string.") +(make-obsolete-variable 'erc-send-this 'erc-pre-send-functions "27.1") (defcustom erc-insert-modify-hook () "Insertion hook for functions that will change the text's appearance. @@ -1260,7 +1291,7 @@ erc-NAME-enable, and erc-NAME-disable. Example: - ;;;###autoload (autoload \\='erc-replace-mode \"erc-replace\") + ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\") (define-erc-module replace nil \"This mode replaces incoming text according to `erc-replace-alist'.\" ((add-hook \\='erc-insert-modify-hook @@ -1343,10 +1374,11 @@ capabilities." (add-hook hook fun nil t) fun)) -(defsubst erc-log (string) +(define-inline erc-log (string) "Logs STRING if logging is on (see `erc-log-p')." - (when erc-log-p - (erc-log-aux string))) + (inline-quote + (when erc-log-p + (erc-log-aux ,string)))) (defun erc-server-buffer () "Return the server buffer for the current buffer's process. @@ -1590,18 +1622,18 @@ symbol, it may have these values: (dolist (candidate (list buf-name (concat buf-name "/" server))) (if (and (not buffer-name) erc-reuse-buffers - (get-buffer candidate) - (or target + (or (not (get-buffer candidate)) + (or target + (with-current-buffer (get-buffer candidate) + (and (erc-server-buffer-p) + (not (erc-server-process-alive))))) (with-current-buffer (get-buffer candidate) - (and (erc-server-buffer-p) - (not (erc-server-process-alive))))) - (with-current-buffer (get-buffer candidate) - (and (string= erc-session-server server) - (erc-port-equal erc-session-port port)))) + (and (string= erc-session-server server) + (erc-port-equal erc-session-port port))))) (setq buffer-name candidate))) ;; if buffer-name is unset, neither candidate worked out for us, ;; fallback to the old <N> uniquification method: - (or buffer-name (generate-new-buffer-name buf-name)) )) + (or buffer-name (generate-new-buffer-name (concat buf-name "/" server))))) (defun erc-get-buffer-create (server port target) "Create a new buffer based on the arguments." @@ -1924,15 +1956,15 @@ removed from the list will be disabled." (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." (pcase erc-join-buffer - (`window + ('window (if (active-minibuffer-window) (display-buffer buffer) (switch-to-buffer-other-window buffer))) - (`window-noselect + ('window-noselect (display-buffer buffer)) - (`bury + ('bury nil) - (`frame + ('frame (when (or (not erc-reuse-frames) (not (get-buffer-window buffer t))) (let ((frame (make-frame (or erc-frame-alist @@ -2411,11 +2443,7 @@ If STRING is nil, the function does nothing." ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) (let ((cons (nthcdr 3 elt))) (cl-incf (car cons) shift) - (cl-incf (cdr cons) shift))) - ((and (featurep 'xemacs) - (extentp (car elt))) ; (EXTENT START END) - (cl-incf (nth 1 elt) shift) - (cl-incf (nth 2 elt) shift))) + (cl-incf (cdr cons) shift)))) (setq list (cdr list)))))) (defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*" @@ -2506,10 +2534,7 @@ Returns NICK unmodified unless `erc-lurker-trim-nicks' is non-nil." (if erc-lurker-trim-nicks (replace-regexp-in-string - (format "[%s]" - (mapconcat (lambda (char) - (regexp-quote (char-to-string char))) - erc-lurker-ignore-chars "")) + (regexp-opt-charset (string-to-list erc-lurker-ignore-chars)) "" nick) nick)) @@ -2549,10 +2574,8 @@ consumption for long-lived IRC or Emacs sessions." (maphash (lambda (nick last-PRIVMSG-time) (when - (> (float-time (time-subtract - (current-time) - last-PRIVMSG-time)) - erc-lurker-threshold-time) + (time-less-p erc-lurker-threshold-time + (time-since last-PRIVMSG-time)) (remhash nick hash))) hash) (if (zerop (hash-table-count hash)) @@ -2617,9 +2640,8 @@ server within `erc-lurker-threshold-time'. See also (gethash (erc-lurker-maybe-trim nick) (gethash server erc-lurker-state (make-hash-table))))) (or (null last-PRIVMSG-time) - (> (float-time - (time-subtract (current-time) last-PRIVMSG-time)) - erc-lurker-threshold-time)))) + (time-less-p erc-lurker-threshold-time + (time-since last-PRIVMSG-time))))) (defcustom erc-common-server-suffixes '(("openprojects.net\\'" . "OPN") @@ -3398,7 +3420,7 @@ Otherwise leave the channel indicated by LINE." (defun erc-cmd-PING (recipient) "Ping RECIPIENT." - (let ((time (format "%f" (erc-current-time)))) + (let ((time (format-time-string "%s.%6N"))) (erc-log (format "cmd: PING: %s" time)) (erc-cmd-CTCP recipient "PING" time))) @@ -3472,7 +3494,6 @@ If S is non-nil, it will be used as the quit reason." (defun erc-quit-reason-various (s) "Choose a quit reason based on S (a string)." - (when (featurep 'xemacs) (require 'poe)) (let ((res (car (assoc-default (or s "") erc-quit-reason-various-alist 'string-match)))) (cond @@ -3500,7 +3521,6 @@ If S is non-nil, it will be used as the quit reason." (defun erc-part-reason-various (s) "Choose a part reason based on S (a string)." - (when (featurep 'xemacs) (require 'poe)) (let ((res (car (assoc-default (or s "") erc-part-reason-various-alist 'string-match)))) (cond @@ -3601,8 +3621,7 @@ the message given by REASON." (defun erc-cmd-SV () "Say the current ERC and Emacs version into channel." - (erc-send-message (format "I'm using ERC with %s %s (%s%s)%s." - (if (featurep 'xemacs) "XEmacs" "GNU Emacs") + (erc-send-message (format "I'm using ERC with GNU Emacs %s (%s%s)%s." emacs-version system-configuration (concat @@ -3677,8 +3696,10 @@ be displayed." ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-\\(.*\\)$" topic) (let ((ch (match-string 1 topic)) (topic (match-string 2 topic))) - (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) - (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch)) + ;; Ignore all-whitespace topics. + (unless (equal (string-trim topic) "") + (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) + (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))) t) ;; /topic #channel ((string-match "^\\s-*\\([&#+!]\\S-+\\)" topic) @@ -3941,9 +3962,7 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, (let ((minibuffer-allow-text-properties t) (read-map minibuffer-local-map)) (insert (read-from-minibuffer "Message: " - (string (if (featurep 'xemacs) - last-command-char - last-command-event)) + (string last-command-event) read-map)) (erc-send-current-line))) @@ -4270,7 +4289,7 @@ and as second argument the event parsed as a vector." (defun erc-is-message-ctcp-and-not-action-p (message) "Check if MESSAGE is a CTCP message or not." (and (erc-is-message-ctcp-p message) - (not (string-match "^\C-a\\ACTION.*\C-a$" message)))) + (not (string-match "^\C-aACTION.*\C-a$" message)))) (defun erc-format-privmessage (nick msg privp msgp) "Format a PRIVMSG in an insertable fashion." @@ -4476,7 +4495,7 @@ See also: `erc-echo-notice-in-user-buffers', (mapcar #'upcase (cdr (split-string mode))))) erc-channel-banlist))) - ((string-match "^+" mode) + ((string-match "^\\+" mode) ;; Add the banned mask(s) to the ban list (mapc (lambda (mask) @@ -4624,7 +4643,7 @@ See also `erc-display-message'." (user-full-name) (user-login-name) (system-name)))) - (ns (erc-time-diff erc-server-last-sent-time (erc-current-time)))) + (ns (erc-time-diff erc-server-last-sent-time nil))) (when (> ns 0) (setq s (concat s " Idle for " (erc-sec-to-time ns)))) (erc-send-ctcp-notice nick s))) @@ -4713,8 +4732,7 @@ See also `erc-display-message'." nil (let ((time (match-string 1 msg))) (condition-case nil - (let ((delta (erc-time-diff (string-to-number time) - (erc-current-time)))) + (let ((delta (erc-time-diff (string-to-number time) nil))) (erc-display-message nil 'notice 'active 'CTCP-PING ?n nick @@ -4772,10 +4790,7 @@ If non-nil, return from being away." (erc-default-target) (if away-time (format "is back (gone for %s)" - (erc-sec-to-time - (erc-time-diff - (erc-emacs-time-to-erc-time away-time) - (erc-current-time)))) + (erc-sec-to-time (erc-time-diff away-time nil))) "is back"))))))))) (erc-update-mode-line))) @@ -5367,10 +5382,10 @@ submitted line to be intentional." (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) - (let ((now (float-time))) + (let ((now (current-time))) (if (or (not erc-accidental-paste-threshold-seconds) - (< erc-accidental-paste-threshold-seconds - (- now erc-last-input-time))) + (time-less-p erc-accidental-paste-threshold-seconds + (time-subtract now erc-last-input-time))) (save-restriction (widen) (if (< (point) (erc-beg-of-input-line)) @@ -5416,6 +5431,9 @@ submitted line to be intentional." (defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$" "Regular expression used for matching commands in ERC.") +(cl-defstruct erc-input + string insertp sendp) + (defun erc-send-input (input) "Treat INPUT as typed in by the user. It is assumed that the input and the prompt is already deleted. @@ -5431,27 +5449,46 @@ This returns non-nil only if we actually send anything." (beep)) nil) (t - (defvar str) ;; FIXME: Make it obey the "erc-" prefix convention. + ;; This dynamic variable is used by `erc-send-pre-hook'. It's + ;; obsolete, and when it's finally removed, this binding should + ;; also be removed. + (with-suppressed-warnings ((lexical str)) + (defvar str)) (let ((str input) - (erc-insert-this t)) - (setq erc-send-this t) + (erc-insert-this t) + (erc-send-this t) + state) + ;; The calling convention of `erc-send-pre-hook' is that it + ;; should change the dynamic variable `str' or set + ;; `erc-send-this' to nil. This has now been deprecated: + ;; Instead `erc-pre-send-functions' is used as a filter to do + ;; allow both changing and suppressing the string. (run-hook-with-args 'erc-send-pre-hook input) - (when erc-send-this - (if (or (string-match "\n" str) - (not (string-match erc-command-regexp str))) - (mapc - (lambda (line) - (mapc - (lambda (line) - ;; Insert what has to be inserted for this. - (erc-display-msg line) - (erc-process-input-line (concat line "\n") - (null erc-flood-protect) t)) - (or (and erc-flood-protect (erc-split-line line)) - (list line)))) - (split-string str "\n")) - (erc-process-input-line (concat str "\n") t nil)) - t))))) + (setq state (make-erc-input :string str + :insertp erc-insert-this + :sendp erc-send-this)) + (dolist (func erc-pre-send-functions) + ;; The functions can return nil to inhibit sending. + (funcall func state)) + (when (and (erc-input-sendp state) + erc-send-this) + (let ((string (erc-input-string state))) + (if (or (string-match "\n" string) + (not (string-match erc-command-regexp string))) + (mapc + (lambda (line) + (mapc + (lambda (line) + ;; Insert what has to be inserted for this. + (when (erc-input-insertp state) + (erc-display-msg line)) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) t)) + (or (and erc-flood-protect (erc-split-line line)) + (list line)))) + (split-string string "\n")) + (erc-process-input-line (concat string "\n") t nil)) + t)))))) (defun erc-display-command (line) (when erc-insert-this @@ -5720,8 +5757,6 @@ If \"l\" is pressed, `erc-set-channel-limit' gets called. If \"k\" is pressed, `erc-set-channel-key' gets called. Anything else will be sent to `erc-toggle-channel-mode'." (interactive "kChannel mode (RET to set more than one): ") - (when (featurep 'xemacs) - (setq key (char-to-string (event-to-character (aref key 0))))) (cond ((equal key "\C-g") (keyboard-quit)) ((equal key "\C-m") @@ -6020,23 +6055,20 @@ non-nil value is found. ;; time routines -(defun erc-string-to-emacs-time (string) - "Convert the long number represented by STRING into an Emacs format. -Returns a list of the form (HIGH LOW), compatible with Emacs time format." - (let* ((n (string-to-number (concat string ".0")))) - (list (truncate (/ n 65536)) - (truncate (mod n 65536))))) +(define-obsolete-function-alias 'erc-string-to-emacs-time 'string-to-number + "27.1") (defalias 'erc-emacs-time-to-erc-time 'float-time) (defalias 'erc-current-time 'float-time) (defun erc-time-diff (t1 t2) - "Return the time difference in seconds between T1 and T2." - (abs (- t2 t1))) + "Return the absolute value of the difference in seconds between T1 and T2." + (abs (float-time (time-subtract t1 t2)))) (defun erc-time-gt (t1 t2) "Check whether T1 > T2." - (> t1 t2)) + (declare (obsolete time-less-p "27.1")) + (time-less-p t2 t1)) (defun erc-sec-to-time (ns) "Convert NS to a time string HH:MM.SS." @@ -6368,14 +6400,9 @@ if `erc-away' is non-nil." (funcall erc-header-line-face-method)) (t 'erc-header-line)))) - (cond ((featurep 'xemacs) - (setq modeline-buffer-identification - (list (format-spec erc-mode-line-format spec))) - (setq modeline-process (list process-status))) - (t - (setq mode-line-buffer-identification - (list (format-spec erc-mode-line-format spec))) - (setq mode-line-process (list process-status)))) + (setq mode-line-buffer-identification + (list (format-spec erc-mode-line-format spec))) + (setq mode-line-process (list process-status)) (when (boundp 'header-line-format) (let ((header (if erc-header-line-format (format-spec erc-header-line-format spec) @@ -6403,9 +6430,7 @@ if `erc-away' is non-nil." (if face (erc-propertize header 'face face) header))))))) - (if (featurep 'xemacs) - (redraw-modeline) - (force-mode-line-update)))) + (force-mode-line-update))) (defun erc-update-mode-line (&optional buffer) "Update the mode line in BUFFER. |