mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-26 07:33:47 +00:00
Use cl-lib instead of cl, and interactive-p => called-interactively-p.
* lisp/erc/erc-track.el, lisp/erc/erc-networks.el, lisp/erc/erc-netsplit.el: * lisp/erc/erc-dcc.el, lisp/erc/erc-backend.el: Use cl-lib, nth, pcase, and called-interactively-p instead of cl. * lisp/erc/erc-speedbar.el, lisp/erc/erc-services.el: * lisp/erc/erc-pcomplete.el, lisp/erc/erc-notify.el, lisp/erc/erc-match.el: * lisp/erc/erc-log.el, lisp/erc/erc-join.el, lisp/erc/erc-ezbounce.el: * lisp/erc/erc-capab.el: Don't require cl since we don't use it. * lisp/erc/erc.el: Use cl-lib, nth, pcase, and called-interactively-p i.s.o cl. (erc-lurker-ignore-chars, erc-common-server-suffixes): Move before first use. * lisp/json.el: Don't require cl since we don't use it. * lisp/color.el: Don't require cl. (color-complement): `caddr' -> `nth 2'. * test/automated/ert-x-tests.el: Use cl-lib. * test/automated/ert-tests.el: Use lexical-binding and cl-lib.
This commit is contained in:
Stefan Monnier
parent
855b17af8f
commit
19dc72069c
@ -1,5 +1,9 @@
|
||||
2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* json.el: Don't require cl since we don't use it.
|
||||
* color.el: Don't require cl.
|
||||
(color-complement): `caddr' -> `nth 2'.
|
||||
|
||||
* calendar/time-date.el (time-to-seconds): De-obsolete.
|
||||
|
||||
2012-11-19 Jay Belanger <jay.p.belanger@gmail.com>
|
||||
|
||||
@ -33,9 +33,6 @@
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
;; Emacs < 23.3
|
||||
(eval-and-compile
|
||||
(unless (boundp 'float-pi)
|
||||
@ -69,9 +66,9 @@ RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive."
|
||||
COLOR-NAME should be a string naming a color (e.g. \"white\"), or
|
||||
a string specifying a color's RGB components (e.g. \"#ff12ec\")."
|
||||
(let ((color (color-name-to-rgb color-name)))
|
||||
(list (- 1.0 (car color))
|
||||
(- 1.0 (cadr color))
|
||||
(- 1.0 (caddr color)))))
|
||||
(list (- 1.0 (nth 0 color))
|
||||
(- 1.0 (nth 1 color))
|
||||
(- 1.0 (nth 2 color)))))
|
||||
|
||||
(defun color-gradient (start stop step-number)
|
||||
"Return a list with STEP-NUMBER colors from START to STOP.
|
||||
|
||||
@ -1,3 +1,16 @@
|
||||
2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
Use cl-lib instead of cl, and interactive-p => called-interactively-p.
|
||||
* erc-track.el, erc-networks.el, erc-netsplit.el, erc-dcc.el:
|
||||
* erc-backend.el: Use cl-lib, nth, pcase, and called-interactively-p
|
||||
instead of cl.
|
||||
* erc-speedbar.el, erc-services.el, erc-pcomplete.el, erc-notify.el:
|
||||
* erc-match.el, erc-log.el, erc-join.el, erc-ezbounce.el:
|
||||
* erc-capab.el: Don't require cl since we don't use it.
|
||||
* erc.el: Use cl-lib, nth, pcase, and called-interactively-p i.s.o cl.
|
||||
(erc-lurker-ignore-chars, erc-common-server-suffixes):
|
||||
Move before first use.
|
||||
|
||||
2012-11-16 Glenn Morris <rgm@gnu.org>
|
||||
|
||||
* erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc.
|
||||
|
||||
@ -98,7 +98,7 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'erc-compat)
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
;; There's a fairly strong mutual dependency between erc.el and erc-backend.el.
|
||||
;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the
|
||||
;; reverse is true:
|
||||
@ -109,7 +109,7 @@
|
||||
(defvar erc-server-responses (make-hash-table :test #'equal)
|
||||
"Hashtable mapping server responses to their handler hooks.")
|
||||
|
||||
(defstruct (erc-response (:conc-name erc-response.))
|
||||
(cl-defstruct (erc-response (:conc-name erc-response.))
|
||||
(unparsed "" :type string)
|
||||
(sender "" :type string)
|
||||
(command "" :type string)
|
||||
@ -950,7 +950,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called."
|
||||
(push str (erc-response.command-args msg))))
|
||||
|
||||
(setf (erc-response.contents msg)
|
||||
(first (erc-response.command-args msg)))
|
||||
(car (erc-response.command-args msg)))
|
||||
|
||||
(setf (erc-response.command-args msg)
|
||||
(nreverse (erc-response.command-args msg)))
|
||||
@ -1045,7 +1045,7 @@ Finds hooks by looking in the `erc-server-responses' hashtable."
|
||||
(name &rest name)
|
||||
&optional sexp sexp def-body))
|
||||
|
||||
(defmacro* define-erc-response-handler ((name &rest aliases)
|
||||
(cl-defmacro define-erc-response-handler ((name &rest aliases)
|
||||
&optional extra-fn-doc extra-var-doc
|
||||
&rest fn-body)
|
||||
"Define an ERC handler hook/function pair.
|
||||
@ -1154,11 +1154,11 @@ add things to `%s' instead."
|
||||
"")
|
||||
name hook-name))
|
||||
(fn-alternates
|
||||
(loop for alias in aliases
|
||||
collect (intern (format "erc-server-%s" alias))))
|
||||
(cl-loop for alias in aliases
|
||||
collect (intern (format "erc-server-%s" alias))))
|
||||
(var-alternates
|
||||
(loop for alias in aliases
|
||||
collect (intern (format "erc-server-%s-functions" alias)))))
|
||||
(cl-loop for alias in aliases
|
||||
collect (intern (format "erc-server-%s-functions" alias)))))
|
||||
`(prog2
|
||||
;; Normal hook variable.
|
||||
(defvar ,hook-name ',fn-name ,(format hook-doc name))
|
||||
@ -1172,19 +1172,19 @@ add things to `%s' instead."
|
||||
(put ',hook-name 'definition-name ',name)
|
||||
|
||||
;; Hashtable map of responses to hook variables
|
||||
,@(loop for response in (cons name aliases)
|
||||
for var in (cons hook-name var-alternates)
|
||||
collect `(puthash ,(format "%s" response) ',var
|
||||
erc-server-responses))
|
||||
,@(cl-loop for response in (cons name aliases)
|
||||
for var in (cons hook-name var-alternates)
|
||||
collect `(puthash ,(format "%s" response) ',var
|
||||
erc-server-responses))
|
||||
;; Alternates.
|
||||
;; Functions are defaliased, hook variables are defvared so we
|
||||
;; can add hooks to one alias, but not another.
|
||||
,@(loop for fn in fn-alternates
|
||||
for var in var-alternates
|
||||
for a in aliases
|
||||
nconc (list `(defalias ',fn ',fn-name)
|
||||
`(defvar ,var ',fn-name ,(format hook-doc a))
|
||||
`(put ',var 'definition-name ',hook-name))))))
|
||||
,@(cl-loop for fn in fn-alternates
|
||||
for var in var-alternates
|
||||
for a in aliases
|
||||
nconc (list `(defalias ',fn ',fn-name)
|
||||
`(defvar ,var ',fn-name ,(format hook-doc a))
|
||||
`(put ',var 'definition-name ',hook-name))))))
|
||||
|
||||
(define-erc-response-handler (ERROR)
|
||||
"Handle an ERROR command from the server." nil
|
||||
@ -1196,10 +1196,10 @@ add things to `%s' instead."
|
||||
(define-erc-response-handler (INVITE)
|
||||
"Handle invitation messages."
|
||||
nil
|
||||
(let ((target (first (erc-response.command-args parsed)))
|
||||
(let ((target (car (erc-response.command-args parsed)))
|
||||
(chnl (erc-response.contents parsed)))
|
||||
(multiple-value-bind (nick login host)
|
||||
(values-list (erc-parse-user (erc-response.sender parsed)))
|
||||
(pcase-let ((`(,nick ,login ,host)
|
||||
(erc-parse-user (erc-response.sender parsed))))
|
||||
(setq erc-invitation chnl)
|
||||
(when (string= target (erc-current-nick))
|
||||
(erc-display-message
|
||||
@ -1212,8 +1212,8 @@ add things to `%s' instead."
|
||||
nil
|
||||
(let ((chnl (erc-response.contents parsed))
|
||||
(buffer nil))
|
||||
(multiple-value-bind (nick login host)
|
||||
(values-list (erc-parse-user (erc-response.sender parsed)))
|
||||
(pcase-let ((`(,nick ,login ,host)
|
||||
(erc-parse-user (erc-response.sender parsed))))
|
||||
;; strip the stupid combined JOIN facility (IRC 2.9)
|
||||
(if (string-match "^\\(.*\\)?\^g.*$" chnl)
|
||||
(setq chnl (match-string 1 chnl)))
|
||||
@ -1249,12 +1249,12 @@ add things to `%s' instead."
|
||||
|
||||
(define-erc-response-handler (KICK)
|
||||
"Handle kick messages received from the server." nil
|
||||
(let* ((ch (first (erc-response.command-args parsed)))
|
||||
(tgt (second (erc-response.command-args parsed)))
|
||||
(let* ((ch (nth 0 (erc-response.command-args parsed)))
|
||||
(tgt (nth 1 (erc-response.command-args parsed)))
|
||||
(reason (erc-trim-string (erc-response.contents parsed)))
|
||||
(buffer (erc-get-buffer ch proc)))
|
||||
(multiple-value-bind (nick login host)
|
||||
(values-list (erc-parse-user (erc-response.sender parsed)))
|
||||
(pcase-let ((`(,nick ,login ,host)
|
||||
(erc-parse-user (erc-response.sender parsed))))
|
||||
(erc-remove-channel-member buffer tgt)
|
||||
(cond
|
||||
((string= tgt (erc-current-nick))
|
||||
@ -1277,11 +1277,11 @@ add things to `%s' instead."
|
||||
|
||||
(define-erc-response-handler (MODE)
|
||||
"Handle server mode changes." nil
|
||||
(let ((tgt (first (erc-response.command-args parsed)))
|
||||
(let ((tgt (car (erc-response.command-args parsed)))
|
||||
(mode (mapconcat 'identity (cdr (erc-response.command-args parsed))
|
||||
" ")))
|
||||
(multiple-value-bind (nick login host)
|
||||
(values-list (erc-parse-user (erc-response.sender parsed)))
|
||||
(pcase-let ((`(,nick ,login ,host)
|
||||
(erc-parse-user (erc-response.sender parsed))))
|
||||
(erc-log (format "MODE: %s -> %s: %s" nick tgt mode))
|
||||
;; dirty hack
|
||||
(let ((buf (cond ((erc-channel-p tgt)
|
||||
@ -1305,8 +1305,8 @@ add things to `%s' instead."
|
||||
"Handle nick change messages." nil
|
||||
(let ((nn (erc-response.contents parsed))
|
||||
bufs)
|
||||
(multiple-value-bind (nick login host)
|
||||
(values-list (erc-parse-user (erc-response.sender parsed)))
|
||||
(pcase-let ((`(,nick ,login ,host)
|
||||
(erc-parse-user (erc-response.sender parsed))))
|
||||
(setq bufs (erc-buffer-list-with-nick nick proc))
|
||||
(erc-log (format "NICK: %s -> %s" nick nn))
|
||||
;; if we had a query with this user, make sure future messages will be
|
||||
@ -1340,11 +1340,11 @@ add things to `%s' instead."
|
||||
|
||||
(define-erc-response-handler (PART)
|
||||
"Handle part messages." nil
|
||||
(let* ((chnl (first (erc-response.command-args parsed)))
|
||||
(let* ((chnl (car (erc-response.command-args parsed)))
|
||||
(reason (erc-trim-string (erc-response.contents parsed)))
|
||||
(buffer (erc-get-buffer chnl proc)))
|
||||
(multiple-value-bind (nick login host)
|
||||
(values-list (erc-parse-user (erc-response.sender parsed)))
|
||||
(pcase-let ((`(,nick ,login ,host)
|
||||
(erc-parse-user (erc-response.sender parsed))))
|
||||
(erc-remove-channel-member buffer nick)
|
||||
(erc-display-message parsed 'notice buffer
|
||||
'PART ?n nick ?u login
|
||||
@ -1361,7 +1361,7 @@ add things to `%s' instead."
|
||||
|
||||
(define-erc-response-handler (PING)
|
||||
"Handle ping messages." nil
|
||||
(let ((pinger (first (erc-response.command-args parsed))))
|
||||
(let ((pinger (car (erc-response.command-args parsed))))
|
||||
(erc-log (format "PING: %s" pinger))
|
||||
;; ping response to the server MUST be forced, or you can lose big
|
||||
(erc-server-send (format "PONG :%s" pinger) t)
|
||||
@ -1379,7 +1379,7 @@ add things to `%s' instead."
|
||||
(when erc-verbose-server-ping
|
||||
(erc-display-message
|
||||
parsed 'notice proc 'PONG
|
||||
?h (first (erc-response.command-args parsed)) ?i erc-server-lag
|
||||
?h (car (erc-response.command-args parsed)) ?i erc-server-lag
|
||||
?s (if (/= erc-server-lag 1) "s" "")))
|
||||
(erc-update-mode-line))))
|
||||
|
||||
@ -1451,8 +1451,8 @@ add things to `%s' instead."
|
||||
"Another user has quit IRC." nil
|
||||
(let ((reason (erc-response.contents parsed))
|
||||
bufs)
|
||||
(multiple-value-bind (nick login host)
|
||||
(values-list (erc-parse-user (erc-response.sender parsed)))
|
||||
(pcase-let ((`(,nick ,login ,host)
|
||||
(erc-parse-user (erc-response.sender parsed))))
|
||||
(setq bufs (erc-buffer-list-with-nick nick proc))
|
||||
(erc-remove-user nick)
|
||||
(setq reason (erc-wash-quit-reason reason nick login host))
|
||||
@ -1462,12 +1462,12 @@ add things to `%s' instead."
|
||||
|
||||
(define-erc-response-handler (TOPIC)
|
||||
"The channel topic has changed." nil
|
||||
(let* ((ch (first (erc-response.command-args parsed)))
|
||||
(let* ((ch (car (erc-response.command-args parsed)))
|
||||
(topic (erc-trim-string (erc-response.contents parsed)))
|
||||
(time (format-time-string erc-server-timestamp-format
|
||||
(current-time))))
|
||||
(multiple-value-bind (nick login host)
|
||||
(values-list (erc-parse-user (erc-response.sender parsed)))
|
||||
(pcase-let ((`(,nick ,login ,host)
|
||||
(erc-parse-user (erc-response.sender parsed))))
|
||||
(erc-update-channel-member ch nick nick nil nil nil host login)
|
||||
(erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time))
|
||||
(erc-display-message parsed 'notice (erc-get-buffer ch proc)
|
||||
@ -1477,8 +1477,8 @@ add things to `%s' instead."
|
||||
(define-erc-response-handler (WALLOPS)
|
||||
"Display a WALLOPS message." nil
|
||||
(let ((message (erc-response.contents parsed)))
|
||||
(multiple-value-bind (nick login host)
|
||||
(values-list (erc-parse-user (erc-response.sender parsed)))
|
||||
(pcase-let ((`(,nick ,login ,host)
|
||||
(erc-parse-user (erc-response.sender parsed))))
|
||||
(erc-display-message
|
||||
parsed 'notice nil
|
||||
'WALLOPS ?n nick ?m message))))
|
||||
@ -1486,7 +1486,7 @@ add things to `%s' instead."
|
||||
(define-erc-response-handler (001)
|
||||
"Set `erc-server-current-nick' to reflect server settings and display the welcome message."
|
||||
nil
|
||||
(erc-set-current-nick (first (erc-response.command-args parsed)))
|
||||
(erc-set-current-nick (car (erc-response.command-args parsed)))
|
||||
(erc-update-mode-line) ; needed here?
|
||||
(setq erc-nick-change-attempt-count 0)
|
||||
(setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
|
||||
@ -1507,16 +1507,16 @@ add things to `%s' instead."
|
||||
|
||||
(define-erc-response-handler (004)
|
||||
"Display the server's identification." nil
|
||||
(multiple-value-bind (server-name server-version)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,server-name ,server-version)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(setq erc-server-version server-version)
|
||||
(setq erc-server-announced-name server-name)
|
||||
(erc-update-mode-line-buffer (process-buffer proc))
|
||||
(erc-display-message
|
||||
parsed 'notice proc
|
||||
's004 ?s server-name ?v server-version
|
||||
?U (fourth (erc-response.command-args parsed))
|
||||
?C (fifth (erc-response.command-args parsed)))))
|
||||
?U (nth 3 (erc-response.command-args parsed))
|
||||
?C (nth 4 (erc-response.command-args parsed)))))
|
||||
|
||||
(define-erc-response-handler (005)
|
||||
"Set the variable `erc-server-parameters' and display the received message.
|
||||
@ -1547,7 +1547,7 @@ A server may send more than one 005 message."
|
||||
|
||||
(define-erc-response-handler (221)
|
||||
"Display the current user modes." nil
|
||||
(let* ((nick (first (erc-response.command-args parsed)))
|
||||
(let* ((nick (car (erc-response.command-args parsed)))
|
||||
(modes (mapconcat 'identity
|
||||
(cdr (erc-response.command-args parsed)) " ")))
|
||||
(erc-set-modes nick modes)
|
||||
@ -1576,8 +1576,8 @@ See `erc-display-server-message'." nil
|
||||
|
||||
(define-erc-response-handler (275)
|
||||
"Display secure connection message." nil
|
||||
(multiple-value-bind (nick user message)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,nick ,user ,message)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(erc-display-message
|
||||
parsed 'notice 'active 's275
|
||||
?n nick
|
||||
@ -1612,8 +1612,8 @@ See `erc-display-server-message'." nil
|
||||
|
||||
(define-erc-response-handler (307)
|
||||
"Display nick-identified message." nil
|
||||
(multiple-value-bind (nick user message)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,nick ,user ,message)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(erc-display-message
|
||||
parsed 'notice 'active 's307
|
||||
?n nick
|
||||
@ -1624,8 +1624,8 @@ See `erc-display-server-message'." nil
|
||||
"WHOIS/WHOWAS notices." nil
|
||||
(let ((fname (erc-response.contents parsed))
|
||||
(catalog-entry (intern (format "s%s" (erc-response.command parsed)))))
|
||||
(multiple-value-bind (nick user host)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,nick ,user ,host)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(erc-update-user-nick nick nick host nil fname user)
|
||||
(erc-display-message
|
||||
parsed 'notice 'active catalog-entry
|
||||
@ -1633,8 +1633,8 @@ See `erc-display-server-message'." nil
|
||||
|
||||
(define-erc-response-handler (312)
|
||||
"Server name response in WHOIS." nil
|
||||
(multiple-value-bind (nick server-host)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,nick ,server-host))
|
||||
(cdr (erc-response.command-args parsed)))
|
||||
(erc-display-message
|
||||
parsed 'notice 'active 's312
|
||||
?n nick ?s server-host ?c (erc-response.contents parsed))))
|
||||
@ -1655,8 +1655,8 @@ See `erc-display-server-message'." nil
|
||||
|
||||
(define-erc-response-handler (317)
|
||||
"IDLE notice." nil
|
||||
(multiple-value-bind (nick seconds-idle on-since time)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,nick ,seconds-idle ,on-since ,time)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(setq time (when on-since
|
||||
(format-time-string erc-server-timestamp-format
|
||||
(erc-string-to-emacs-time on-since))))
|
||||
@ -1696,16 +1696,16 @@ See `erc-display-server-message'." nil
|
||||
(define-erc-response-handler (322)
|
||||
"LIST notice." nil
|
||||
(let ((topic (erc-response.contents parsed)))
|
||||
(multiple-value-bind (channel num-users)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,channel ,num-users)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(add-to-list 'erc-channel-list (list channel))
|
||||
(erc-update-channel-topic channel topic))))
|
||||
|
||||
(defun erc-server-322-message (proc parsed)
|
||||
"Display a message for the 322 event."
|
||||
(let ((topic (erc-response.contents parsed)))
|
||||
(multiple-value-bind (channel num-users)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,channel ,num-users)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(erc-display-message
|
||||
parsed 'notice proc 's322
|
||||
?c channel ?u num-users ?t (or topic "")))))
|
||||
@ -1732,7 +1732,7 @@ See `erc-display-server-message'." nil
|
||||
"Channel creation date." nil
|
||||
(let ((channel (second (erc-response.command-args parsed)))
|
||||
(time (erc-string-to-emacs-time
|
||||
(third (erc-response.command-args parsed)))))
|
||||
(nth 2 (erc-response.command-args parsed)))))
|
||||
(erc-display-message
|
||||
parsed 'notice (erc-get-buffer channel proc)
|
||||
's329 ?c channel ?t (format-time-string erc-server-timestamp-format
|
||||
@ -1749,7 +1749,7 @@ See `erc-display-server-message'." nil
|
||||
;; authmsg == (aref parsed 5)
|
||||
;; The guesses below are, well, just that. -- Lawrence 2004/05/10
|
||||
(let ((nick (second (erc-response.command-args parsed)))
|
||||
(authaccount (third (erc-response.command-args parsed)))
|
||||
(authaccount (nth 2 (erc-response.command-args parsed)))
|
||||
(authmsg (erc-response.contents parsed)))
|
||||
(erc-display-message parsed 'notice 'active 's330
|
||||
?n nick ?a authmsg ?i authaccount)))
|
||||
@ -1771,8 +1771,8 @@ See `erc-display-server-message'." nil
|
||||
|
||||
(define-erc-response-handler (333)
|
||||
"Who set the topic, and when." nil
|
||||
(multiple-value-bind (channel nick time)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,channel ,nick ,time)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(setq time (format-time-string erc-server-timestamp-format
|
||||
(erc-string-to-emacs-time time)))
|
||||
(erc-update-channel-topic channel
|
||||
@ -1784,15 +1784,15 @@ See `erc-display-server-message'." nil
|
||||
(define-erc-response-handler (341)
|
||||
"Let user know when an INVITE attempt has been sent successfully."
|
||||
nil
|
||||
(multiple-value-bind (nick channel)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,nick ,channel)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(erc-display-message parsed 'notice (erc-get-buffer channel proc)
|
||||
's341 ?n nick ?c channel)))
|
||||
|
||||
(define-erc-response-handler (352)
|
||||
"WHO notice." nil
|
||||
(multiple-value-bind (channel user host server nick away-flag)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,channel ,user ,host ,server ,nick ,away-flag)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(let ((full-name (erc-response.contents parsed))
|
||||
hopcount)
|
||||
(when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name)
|
||||
@ -1806,7 +1806,7 @@ See `erc-display-server-message'." nil
|
||||
|
||||
(define-erc-response-handler (353)
|
||||
"NAMES notice." nil
|
||||
(let ((channel (third (erc-response.command-args parsed)))
|
||||
(let ((channel (nth 2 (erc-response.command-args parsed)))
|
||||
(users (erc-response.contents parsed)))
|
||||
(erc-display-message parsed 'notice (or (erc-get-buffer channel proc)
|
||||
'active)
|
||||
@ -1821,8 +1821,8 @@ See `erc-display-server-message'." nil
|
||||
|
||||
(define-erc-response-handler (367)
|
||||
"Channel ban list entries." nil
|
||||
(multiple-value-bind (channel banmask setter time)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,channel ,banmask ,setter ,time)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
;; setter and time are not standard
|
||||
(if setter
|
||||
(erc-display-message parsed 'notice 'active 's367-set-by
|
||||
@ -1845,8 +1845,8 @@ See `erc-display-server-message'." nil
|
||||
;; FIXME: Yet more magic numbers in original code, I'm guessing this
|
||||
;; command takes two arguments, and doesn't have any "contents". --
|
||||
;; Lawrence 2004/05/10
|
||||
(multiple-value-bind (from to)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,from ,to)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
(erc-display-message parsed 'notice 'active
|
||||
's379 ?c from ?f to)))
|
||||
|
||||
@ -1855,7 +1855,7 @@ See `erc-display-server-message'." nil
|
||||
(erc-display-message
|
||||
parsed 'notice 'active
|
||||
's391 ?s (second (erc-response.command-args parsed))
|
||||
?t (third (erc-response.command-args parsed))))
|
||||
?t (nth 2 (erc-response.command-args parsed))))
|
||||
|
||||
(define-erc-response-handler (401)
|
||||
"No such nick/channel." nil
|
||||
|
||||
@ -68,7 +68,6 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;;; Customization:
|
||||
|
||||
|
||||
@ -54,9 +54,7 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile
|
||||
(require 'cl)
|
||||
(require 'pcomplete))
|
||||
(eval-when-compile (require 'pcomplete))
|
||||
|
||||
;;;###autoload (autoload 'erc-dcc-mode "erc-dcc")
|
||||
(define-erc-module dcc nil
|
||||
@ -277,7 +275,7 @@ Argument IP is the address as a string. The result is also a string."
|
||||
(* (nth 1 ips) 65536.0)
|
||||
(* (nth 2 ips) 256.0)
|
||||
(nth 3 ips))))
|
||||
(if (interactive-p)
|
||||
(if (called-interactively-p 'interactive)
|
||||
(message "%s is %.0f" ip res)
|
||||
(format "%.0f" res)))))
|
||||
|
||||
@ -380,8 +378,8 @@ created subprocess, or nil."
|
||||
(with-no-warnings ; obsolete since 23.1
|
||||
(set-process-filter-multibyte process nil)))))
|
||||
(file-error
|
||||
(unless (and (string= "Cannot bind server socket" (cadr err))
|
||||
(string= "address already in use" (caddr err)))
|
||||
(unless (and (string= "Cannot bind server socket" (nth 1 err))
|
||||
(string= "address already in use" (nth 2 err)))
|
||||
(signal (car err) (cdr err)))
|
||||
(setq port (1+ port))
|
||||
(unless (< port upper)
|
||||
@ -434,38 +432,38 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
|
||||
(pcomplete-here (append '("chat" "close" "get" "list")
|
||||
(when (fboundp 'make-network-process) '("send"))))
|
||||
(pcomplete-here
|
||||
(case (intern (downcase (pcomplete-arg 1)))
|
||||
(chat (mapcar (lambda (elt) (plist-get elt :nick))
|
||||
(erc-remove-if-not
|
||||
#'(lambda (elt)
|
||||
(eq (plist-get elt :type) 'CHAT))
|
||||
erc-dcc-list)))
|
||||
(close (erc-delete-dups
|
||||
(mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
|
||||
erc-dcc-list)))
|
||||
(get (mapcar #'erc-dcc-nick
|
||||
(erc-remove-if-not
|
||||
#'(lambda (elt)
|
||||
(eq (plist-get elt :type) 'GET))
|
||||
erc-dcc-list)))
|
||||
(send (pcomplete-erc-all-nicks))))
|
||||
(pcomplete-here
|
||||
(case (intern (downcase (pcomplete-arg 2)))
|
||||
(get (mapcar (lambda (elt) (plist-get elt :file))
|
||||
(erc-remove-if-not
|
||||
#'(lambda (elt)
|
||||
(and (eq (plist-get elt :type) 'GET)
|
||||
(erc-nick-equal-p (erc-extract-nick
|
||||
(plist-get elt :nick))
|
||||
(pcomplete-arg 1))))
|
||||
erc-dcc-list)))
|
||||
(close (mapcar #'erc-dcc-nick
|
||||
(pcase (intern (downcase (pcomplete-arg 1)))
|
||||
(`chat (mapcar (lambda (elt) (plist-get elt :nick))
|
||||
(erc-remove-if-not
|
||||
#'(lambda (elt)
|
||||
(eq (plist-get elt :type)
|
||||
(intern (upcase (pcomplete-arg 1)))))
|
||||
(eq (plist-get elt :type) 'CHAT))
|
||||
erc-dcc-list)))
|
||||
(send (pcomplete-entries)))))
|
||||
(`close (erc-delete-dups
|
||||
(mapcar (lambda (elt) (symbol-name (plist-get elt :type)))
|
||||
erc-dcc-list)))
|
||||
(`get (mapcar #'erc-dcc-nick
|
||||
(erc-remove-if-not
|
||||
#'(lambda (elt)
|
||||
(eq (plist-get elt :type) 'GET))
|
||||
erc-dcc-list)))
|
||||
(`send (pcomplete-erc-all-nicks))))
|
||||
(pcomplete-here
|
||||
(pcase (intern (downcase (pcomplete-arg 2)))
|
||||
(`get (mapcar (lambda (elt) (plist-get elt :file))
|
||||
(erc-remove-if-not
|
||||
#'(lambda (elt)
|
||||
(and (eq (plist-get elt :type) 'GET)
|
||||
(erc-nick-equal-p (erc-extract-nick
|
||||
(plist-get elt :nick))
|
||||
(pcomplete-arg 1))))
|
||||
erc-dcc-list)))
|
||||
(`close (mapcar #'erc-dcc-nick
|
||||
(erc-remove-if-not
|
||||
#'(lambda (elt)
|
||||
(eq (plist-get elt :type)
|
||||
(intern (upcase (pcomplete-arg 1)))))
|
||||
erc-dcc-list)))
|
||||
(`send (pcomplete-entries)))))
|
||||
|
||||
(defun erc-dcc-do-CHAT-command (proc &optional nick)
|
||||
(when nick
|
||||
@ -1248,7 +1246,7 @@ other client."
|
||||
|
||||
(defun erc-dcc-no-such-nick (proc parsed)
|
||||
"Detect and handle no-such-nick replies from the IRC server."
|
||||
(let* ((elt (erc-dcc-member :nick (second (erc-response.command-args parsed))
|
||||
(let* ((elt (erc-dcc-member :nick (nth 1 (erc-response.command-args parsed))
|
||||
:parent proc))
|
||||
(peer (plist-get elt :peer)))
|
||||
(when (or (and (processp peer) (not (eq (process-status peer) 'open)))
|
||||
|
||||
@ -26,7 +26,6 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup erc-ezbounce nil
|
||||
"Interface to the EZBounce IRC bouncer (a virtual IRC server)"
|
||||
|
||||
@ -34,7 +34,6 @@
|
||||
|
||||
(require 'erc)
|
||||
(require 'auth-source)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup erc-autojoin nil
|
||||
"Enable autojoining."
|
||||
|
||||
@ -93,9 +93,7 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile
|
||||
(require 'erc-networks)
|
||||
(require 'cl))
|
||||
(eval-when-compile (require 'erc-networks))
|
||||
|
||||
(defgroup erc-log nil
|
||||
"Logging facilities for ERC."
|
||||
@ -429,7 +427,8 @@ You can save every individual message by putting this function on
|
||||
file t 'nomessage))))
|
||||
(let ((coding-system-for-write coding-system))
|
||||
(write-region start end file t 'nomessage))))
|
||||
(if (and erc-truncate-buffer-on-save (interactive-p))
|
||||
(if (and erc-truncate-buffer-on-save
|
||||
(called-interactively-p 'interactive))
|
||||
(progn
|
||||
(let ((inhibit-read-only t)) (erase-buffer))
|
||||
(move-marker erc-last-saved-position (point-max))
|
||||
|
||||
@ -35,7 +35,6 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;; Customization:
|
||||
|
||||
|
||||
@ -31,7 +31,6 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup erc-netsplit nil
|
||||
"Netsplit detection tries to automatically figure when a
|
||||
@ -107,7 +106,7 @@ join from that split has been detected or not.")
|
||||
(dolist (elt erc-netsplit-list)
|
||||
(if (member nick (nthcdr 3 elt))
|
||||
(progn
|
||||
(if (not (caddr elt))
|
||||
(if (not (nth 2 elt))
|
||||
(progn
|
||||
(erc-display-message
|
||||
parsed 'notice (process-buffer proc)
|
||||
@ -149,7 +148,7 @@ join from that split has been detected or not.")
|
||||
;; element for this netsplit exists already
|
||||
(progn
|
||||
(setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass)))
|
||||
(when (caddr ass)
|
||||
(when (nth 2 ass)
|
||||
;; There was already a netjoin for this netsplit, it
|
||||
;; seems like the old one didn't get finished...
|
||||
(erc-display-message
|
||||
@ -194,7 +193,7 @@ join from that split has been detected or not.")
|
||||
nil 'notice 'active
|
||||
'netsplit-wholeft ?s (car elt)
|
||||
?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ")
|
||||
?t (if (caddr elt)
|
||||
?t (if (nth 2 elt)
|
||||
"(joining)"
|
||||
"")))))
|
||||
t)
|
||||
|
||||
@ -40,7 +40,7 @@
|
||||
;;; Code:
|
||||
|
||||
(require 'erc)
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
;; Variables
|
||||
|
||||
@ -729,10 +729,10 @@ search for a match in `erc-networks-alist'."
|
||||
(or
|
||||
;; Loop through `erc-networks-alist' looking for a match.
|
||||
(let ((server (or erc-server-announced-name erc-session-server)))
|
||||
(loop for (name matcher) in erc-networks-alist
|
||||
when (and matcher
|
||||
(string-match (concat matcher "\\'") server))
|
||||
do (return name)))
|
||||
(cl-loop for (name matcher) in erc-networks-alist
|
||||
when (and matcher
|
||||
(string-match (concat matcher "\\'") server))
|
||||
do (cl-return name)))
|
||||
'Unknown)))
|
||||
|
||||
(defun erc-network ()
|
||||
@ -789,8 +789,8 @@ As an example:
|
||||
(cond ((numberp p)
|
||||
(push p result))
|
||||
((listp p)
|
||||
(setq result (nconc (loop for i from (cadr p) downto (car p)
|
||||
collect i)
|
||||
(setq result (nconc (cl-loop for i from (cadr p) downto (car p)
|
||||
collect i)
|
||||
result)))))
|
||||
(nreverse result)))
|
||||
|
||||
|
||||
@ -30,9 +30,7 @@
|
||||
|
||||
(require 'erc)
|
||||
(require 'erc-networks)
|
||||
(eval-when-compile
|
||||
(require 'cl)
|
||||
(require 'pcomplete))
|
||||
(eval-when-compile (require 'pcomplete))
|
||||
|
||||
;;;; Customizable variables
|
||||
|
||||
|
||||
@ -43,7 +43,6 @@
|
||||
(require 'erc)
|
||||
(require 'erc-compat)
|
||||
(require 'time-date)
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup erc-pcomplete nil
|
||||
"Programmable completion for ERC"
|
||||
|
||||
@ -62,7 +62,7 @@
|
||||
|
||||
(require 'erc)
|
||||
(require 'erc-networks)
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
|
||||
;; Customization:
|
||||
|
||||
|
||||
@ -38,7 +38,6 @@
|
||||
(require 'erc)
|
||||
(require 'speedbar)
|
||||
(condition-case nil (require 'dframe) (error nil))
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;;; Customization:
|
||||
|
||||
|
||||
@ -34,7 +34,7 @@
|
||||
;; * Add extensibility so that custom functions can track
|
||||
;; custom modification types.
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
(require 'erc)
|
||||
(require 'erc-compat)
|
||||
(require 'erc-match)
|
||||
@ -484,7 +484,7 @@ START is the minimum length of the name used."
|
||||
|
||||
;;; Test:
|
||||
|
||||
(assert
|
||||
(cl-assert
|
||||
(and
|
||||
;; verify examples from the doc strings
|
||||
(equal (let ((erc-track-shorten-aggressively nil))
|
||||
@ -869,7 +869,7 @@ Use `erc-make-mode-line-buffer-name' to create buttons."
|
||||
(setq erc-modified-channels-alist
|
||||
(delete (assq buffer erc-modified-channels-alist)
|
||||
erc-modified-channels-alist))
|
||||
(when (interactive-p)
|
||||
(when (called-interactively-p 'interactive)
|
||||
(erc-modified-channels-display)))
|
||||
|
||||
(defun erc-track-find-face (faces)
|
||||
@ -980,7 +980,7 @@ is in `erc-mode'."
|
||||
(add-to-list 'faces cur)))
|
||||
faces))
|
||||
|
||||
(assert
|
||||
(cl-assert
|
||||
(let ((str "is bold"))
|
||||
(put-text-property 3 (length str)
|
||||
'face '(bold erc-current-nick-face)
|
||||
@ -1030,17 +1030,17 @@ relative to `erc-track-switch-direction'"
|
||||
(let ((dir erc-track-switch-direction)
|
||||
offset)
|
||||
(when (< arg 0)
|
||||
(setq dir (case dir
|
||||
(oldest 'newest)
|
||||
(newest 'oldest)
|
||||
(mostactive 'leastactive)
|
||||
(leastactive 'mostactive)
|
||||
(importance 'oldest)))
|
||||
(setq dir (pcase dir
|
||||
(`oldest 'newest)
|
||||
(`newest 'oldest)
|
||||
(`mostactive 'leastactive)
|
||||
(`leastactive 'mostactive)
|
||||
(`importance 'oldest)))
|
||||
(setq arg (- arg)))
|
||||
(setq offset (case dir
|
||||
((oldest leastactive)
|
||||
(setq offset (pcase dir
|
||||
((or `oldest `leastactive)
|
||||
(- (length erc-modified-channels-alist) arg))
|
||||
(t (1- arg))))
|
||||
(_ (1- arg))))
|
||||
;; normalize out of range user input
|
||||
(cond ((>= offset (length erc-modified-channels-alist))
|
||||
(setq offset (1- (length erc-modified-channels-alist))))
|
||||
|
||||
@ -67,7 +67,7 @@
|
||||
(defconst erc-version-string "Version 5.3"
|
||||
"ERC version. This is used by function `erc-version'.")
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
(require 'font-lock)
|
||||
(require 'pp)
|
||||
(require 'thingatpt)
|
||||
@ -369,7 +369,7 @@ If no server buffer exists, return nil."
|
||||
(with-current-buffer ,buffer
|
||||
,@body)))))
|
||||
|
||||
(defstruct (erc-server-user (:type vector) :named)
|
||||
(cl-defstruct (erc-server-user (:type vector) :named)
|
||||
;; User data
|
||||
nickname host login full-name info
|
||||
;; Buffers
|
||||
@ -379,7 +379,7 @@ If no server buffer exists, return nil."
|
||||
(buffers nil)
|
||||
)
|
||||
|
||||
(defstruct (erc-channel-user (:type vector) :named)
|
||||
(cl-defstruct (erc-channel-user (:type vector) :named)
|
||||
op voice
|
||||
;; Last message time (in the form of the return value of
|
||||
;; (current-time)
|
||||
@ -1386,7 +1386,7 @@ If BUFFER is nil, the current buffer is used."
|
||||
t))
|
||||
(erc-server-send (format "ISON %s" nick))
|
||||
(while (eq erc-online-p 'unknown) (accept-process-output))
|
||||
(if (interactive-p)
|
||||
(if (called-interactively-p 'interactive)
|
||||
(message "%s is %sonline"
|
||||
(or erc-online-p nick)
|
||||
(if erc-online-p "" "not "))
|
||||
@ -2157,11 +2157,11 @@ functions in here get called with the parameters SERVER and NICK."
|
||||
(list :server server :port port :nick nick :password passwd)))
|
||||
|
||||
;;;###autoload
|
||||
(defun* erc (&key (server (erc-compute-server))
|
||||
(port (erc-compute-port))
|
||||
(nick (erc-compute-nick))
|
||||
password
|
||||
(full-name (erc-compute-full-name)))
|
||||
(cl-defun erc (&key (server (erc-compute-server))
|
||||
(port (erc-compute-port))
|
||||
(nick (erc-compute-nick))
|
||||
password
|
||||
(full-name (erc-compute-full-name)))
|
||||
"ERC is a powerful, modular, and extensible IRC client.
|
||||
This function is the main entry point for ERC.
|
||||
|
||||
@ -2383,24 +2383,24 @@ If STRING is nil, the function does nothing."
|
||||
(while list
|
||||
(setq elt (car list))
|
||||
(cond ((integerp elt) ; POSITION
|
||||
(incf (car list) shift))
|
||||
(cl-incf (car list) shift))
|
||||
((or (atom elt) ; nil, EXTENT
|
||||
;; (eq t (car elt)) ; (t . TIME)
|
||||
(markerp (car elt))) ; (MARKER . DISTANCE)
|
||||
nil)
|
||||
((integerp (car elt)) ; (BEGIN . END)
|
||||
(incf (car elt) shift)
|
||||
(incf (cdr elt) shift))
|
||||
(cl-incf (car elt) shift)
|
||||
(cl-incf (cdr elt) shift))
|
||||
((stringp (car elt)) ; (TEXT . POSITION)
|
||||
(incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
|
||||
(cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
|
||||
((null (car elt)) ; (nil PROPERTY VALUE BEG . END)
|
||||
(let ((cons (nthcdr 3 elt)))
|
||||
(incf (car cons) shift)
|
||||
(incf (cdr cons) shift)))
|
||||
(cl-incf (car cons) shift)
|
||||
(cl-incf (cdr cons) shift)))
|
||||
((and (featurep 'xemacs)
|
||||
(extentp (car elt))) ; (EXTENT START END)
|
||||
(incf (nth 1 elt) shift)
|
||||
(incf (nth 2 elt) shift)))
|
||||
(cl-incf (nth 1 elt) shift)
|
||||
(cl-incf (nth 2 elt) shift)))
|
||||
(setq list (cdr list))))))
|
||||
|
||||
(defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*"
|
||||
@ -2477,6 +2477,13 @@ purposes."
|
||||
:group 'erc-lurker
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-lurker-ignore-chars "`_"
|
||||
"Characters at the end of a nick to strip for activity tracking purposes.
|
||||
|
||||
See also `erc-lurker-trim-nicks'."
|
||||
:group 'erc-lurker
|
||||
:type 'string)
|
||||
|
||||
(defun erc-lurker-maybe-trim (nick)
|
||||
"Maybe trim trailing `erc-lurker-ignore-chars' from NICK.
|
||||
|
||||
@ -2491,13 +2498,6 @@ non-nil."
|
||||
"" nick)
|
||||
nick))
|
||||
|
||||
(defcustom erc-lurker-ignore-chars "`_"
|
||||
"Characters at the end of a nick to strip for activity tracking purposes.
|
||||
|
||||
See also `erc-lurker-trim-nicks'."
|
||||
:group 'erc-lurker
|
||||
:type 'string)
|
||||
|
||||
(defcustom erc-lurker-hide-list nil
|
||||
"List of IRC type messages to hide when sent by lurkers.
|
||||
|
||||
@ -2580,7 +2580,8 @@ updates of `erc-lurker-state'."
|
||||
(server
|
||||
(erc-canonicalize-server-name erc-server-announced-name)))
|
||||
(when (equal command "PRIVMSG")
|
||||
(when (>= (incf erc-lurker-cleanup-count) erc-lurker-cleanup-interval)
|
||||
(when (>= (cl-incf erc-lurker-cleanup-count)
|
||||
erc-lurker-cleanup-interval)
|
||||
(setq erc-lurker-cleanup-count 0)
|
||||
(erc-lurker-cleanup))
|
||||
(unless (gethash server erc-lurker-state)
|
||||
@ -2605,6 +2606,17 @@ server within `erc-lurker-threshold-time'. See also
|
||||
(time-subtract (current-time) last-PRIVMSG-time))
|
||||
erc-lurker-threshold-time))))
|
||||
|
||||
(defcustom erc-common-server-suffixes
|
||||
'(("openprojects.net$" . "OPN")
|
||||
("freenode.net$" . "freenode")
|
||||
("oftc.net$" . "OFTC"))
|
||||
"Alist of common server name suffixes.
|
||||
This variable is used in mode-line display to save screen
|
||||
real estate. Set it to nil if you want to avoid changing
|
||||
displayed hostnames."
|
||||
:group 'erc-mode-line-and-header
|
||||
:type 'alist)
|
||||
|
||||
(defun erc-canonicalize-server-name (server)
|
||||
"Returns the canonical network name for SERVER if any,
|
||||
otherwise `erc-server-announced-name'. SERVER is matched against
|
||||
@ -3115,37 +3127,37 @@ If SERVER is non-nil, use that, rather than the current server."
|
||||
(add-to-list 'symlist
|
||||
(cons (erc-once-with-server-event
|
||||
311 `(string= ,nick
|
||||
(second
|
||||
(nth 1
|
||||
(erc-response.command-args parsed))))
|
||||
'erc-server-311-functions))
|
||||
(add-to-list 'symlist
|
||||
(cons (erc-once-with-server-event
|
||||
312 `(string= ,nick
|
||||
(second
|
||||
(nth 1
|
||||
(erc-response.command-args parsed))))
|
||||
'erc-server-312-functions))
|
||||
(add-to-list 'symlist
|
||||
(cons (erc-once-with-server-event
|
||||
318 `(string= ,nick
|
||||
(second
|
||||
(nth 1
|
||||
(erc-response.command-args parsed))))
|
||||
'erc-server-318-functions))
|
||||
(add-to-list 'symlist
|
||||
(cons (erc-once-with-server-event
|
||||
319 `(string= ,nick
|
||||
(second
|
||||
(nth 1
|
||||
(erc-response.command-args parsed))))
|
||||
'erc-server-319-functions))
|
||||
(add-to-list 'symlist
|
||||
(cons (erc-once-with-server-event
|
||||
320 `(string= ,nick
|
||||
(second
|
||||
(nth 1
|
||||
(erc-response.command-args parsed))))
|
||||
'erc-server-320-functions))
|
||||
(add-to-list 'symlist
|
||||
(cons (erc-once-with-server-event
|
||||
330 `(string= ,nick
|
||||
(second
|
||||
(nth 1
|
||||
(erc-response.command-args parsed))))
|
||||
'erc-server-330-functions))
|
||||
(add-to-list 'symlist
|
||||
@ -4328,8 +4340,8 @@ See also: `erc-echo-notice-in-user-buffers',
|
||||
|
||||
(defun erc-banlist-store (proc parsed)
|
||||
"Record ban entries for a channel."
|
||||
(multiple-value-bind (channel mask whoset)
|
||||
(values-list (cdr (erc-response.command-args parsed)))
|
||||
(pcase-let ((`(,channel ,mask ,whoset)
|
||||
(cdr (erc-response.command-args parsed))))
|
||||
;; Determine to which buffer the message corresponds
|
||||
(let ((buffer (erc-get-buffer channel proc)))
|
||||
(with-current-buffer buffer
|
||||
@ -4340,7 +4352,7 @@ See also: `erc-echo-notice-in-user-buffers',
|
||||
|
||||
(defun erc-banlist-finished (proc parsed)
|
||||
"Record that we have received the banlist."
|
||||
(let* ((channel (second (erc-response.command-args parsed)))
|
||||
(let* ((channel (nth 1 (erc-response.command-args parsed)))
|
||||
(buffer (erc-get-buffer channel proc)))
|
||||
(with-current-buffer buffer
|
||||
(put 'erc-channel-banlist 'received-from-server t)))
|
||||
@ -4349,7 +4361,7 @@ See also: `erc-echo-notice-in-user-buffers',
|
||||
(defun erc-banlist-update (proc parsed)
|
||||
"Check MODE commands for bans and update the banlist appropriately."
|
||||
;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
|
||||
(let* ((tgt (first (erc-response.command-args parsed)))
|
||||
(let* ((tgt (car (erc-response.command-args parsed)))
|
||||
(mode (erc-response.contents parsed))
|
||||
(whoset (erc-response.sender parsed))
|
||||
(buffer (erc-get-buffer tgt proc)))
|
||||
@ -6000,7 +6012,7 @@ entry of `channel-members'."
|
||||
(if cuser
|
||||
(setq op (erc-channel-user-op cuser)
|
||||
voice (erc-channel-user-voice cuser)))
|
||||
(if (interactive-p)
|
||||
(if (called-interactively-p 'interactive)
|
||||
(message "%s is %s@%s%s%s"
|
||||
nick login host
|
||||
(if full-name (format " (%s)" full-name) "")
|
||||
@ -6088,17 +6100,6 @@ Otherwise, use the `erc-header-line' face."
|
||||
:group 'erc-paranoia
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom erc-common-server-suffixes
|
||||
'(("openprojects.net$" . "OPN")
|
||||
("freenode.net$" . "freenode")
|
||||
("oftc.net$" . "OFTC"))
|
||||
"Alist of common server name suffixes.
|
||||
This variable is used in mode-line display to save screen
|
||||
real estate. Set it to nil if you want to avoid changing
|
||||
displayed hostnames."
|
||||
:group 'erc-mode-line-and-header
|
||||
:type 'alist)
|
||||
|
||||
(defcustom erc-mode-line-away-status-format
|
||||
"(AWAY since %a %b %d %H:%M) "
|
||||
"When you're away on a server, this is shown in the mode line.
|
||||
@ -6302,7 +6303,7 @@ If optional argument HERE is non-nil, insert version number at point."
|
||||
(format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version)))
|
||||
(if here
|
||||
(insert version-string)
|
||||
(if (interactive-p)
|
||||
(if (called-interactively-p 'interactive)
|
||||
(message "%s" version-string)
|
||||
version-string))))
|
||||
|
||||
@ -6322,7 +6323,7 @@ If optional argument HERE is non-nil, insert version number at point."
|
||||
", ")))
|
||||
(if here
|
||||
(insert string)
|
||||
(if (interactive-p)
|
||||
(if (called-interactively-p 'interactive)
|
||||
(message "%s" string)
|
||||
string))))
|
||||
|
||||
|
||||
@ -51,7 +51,6 @@
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
;; Compatibility code
|
||||
|
||||
|
||||
@ -1,3 +1,8 @@
|
||||
2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* automated/ert-x-tests.el: Use cl-lib.
|
||||
* automated/ert-tests.el: Use lexical-binding and cl-lib.
|
||||
|
||||
2012-11-14 Dmitry Gutov <dgutov@yandex.ru>
|
||||
|
||||
* automated/ruby-mode-tests.el (ruby-indent-singleton-class): Pass.
|
||||
@ -5,8 +10,8 @@
|
||||
(ruby-indent-inside-heredoc-after-space): New tests.
|
||||
Change direct font-lock face references to var references.
|
||||
(ruby-interpolation-suppresses-syntax-inside): New test.
|
||||
(ruby-interpolation-inside-percent-literal-with-paren): New
|
||||
failing test.
|
||||
(ruby-interpolation-inside-percent-literal-with-paren):
|
||||
New failing test.
|
||||
|
||||
2012-11-13 Dmitry Gutov <dgutov@yandex.ru>
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;; ert-tests.el --- ERT's self-tests
|
||||
;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc.
|
||||
|
||||
@ -27,7 +27,7 @@
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
(require 'cl-lib))
|
||||
(require 'ert)
|
||||
|
||||
|
||||
@ -45,7 +45,7 @@
|
||||
;; The buffer name chosen here should not compete with the default
|
||||
;; results buffer name for completion in `switch-to-buffer'.
|
||||
(let ((stats (ert-run-tests-interactively "^ert-" " *ert self-tests*")))
|
||||
(assert ert--test-body-was-run)
|
||||
(cl-assert ert--test-body-was-run)
|
||||
(if (zerop (ert-stats-completed-unexpected stats))
|
||||
;; Hide results window only when everything went well.
|
||||
(set-window-configuration window-configuration)
|
||||
@ -71,26 +71,26 @@ failed or if there was a problem."
|
||||
|
||||
(ert-deftest ert-test-nested-test-body-runs ()
|
||||
"Test that nested test bodies run."
|
||||
(lexical-let ((was-run nil))
|
||||
(let ((was-run nil))
|
||||
(let ((test (make-ert-test :body (lambda ()
|
||||
(setq was-run t)))))
|
||||
(assert (not was-run))
|
||||
(cl-assert (not was-run))
|
||||
(ert-run-test test)
|
||||
(assert was-run))))
|
||||
(cl-assert was-run))))
|
||||
|
||||
|
||||
;;; Test that pass/fail works.
|
||||
(ert-deftest ert-test-pass ()
|
||||
(let ((test (make-ert-test :body (lambda ()))))
|
||||
(let ((result (ert-run-test test)))
|
||||
(assert (ert-test-passed-p result)))))
|
||||
(cl-assert (ert-test-passed-p result)))))
|
||||
|
||||
(ert-deftest ert-test-fail ()
|
||||
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
|
||||
(let ((result (let ((ert-debug-on-error nil))
|
||||
(ert-run-test test))))
|
||||
(assert (ert-test-failed-p result) t)
|
||||
(assert (equal (ert-test-result-with-condition-condition result)
|
||||
(cl-assert (ert-test-failed-p result) t)
|
||||
(cl-assert (equal (ert-test-result-with-condition-condition result)
|
||||
'(ert-test-failed "failure message"))
|
||||
t))))
|
||||
|
||||
@ -100,50 +100,50 @@ failed or if there was a problem."
|
||||
(progn
|
||||
(let ((ert-debug-on-error t))
|
||||
(ert-run-test test))
|
||||
(assert nil))
|
||||
(cl-assert nil))
|
||||
((error)
|
||||
(assert (equal condition '(ert-test-failed "failure message")) t)))))
|
||||
(cl-assert (equal condition '(ert-test-failed "failure message")) t)))))
|
||||
|
||||
(ert-deftest ert-test-fail-debug-with-debugger-1 ()
|
||||
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
|
||||
(let ((debugger (lambda (&rest debugger-args)
|
||||
(assert nil))))
|
||||
(let ((debugger (lambda (&rest _args)
|
||||
(cl-assert nil))))
|
||||
(let ((ert-debug-on-error nil))
|
||||
(ert-run-test test)))))
|
||||
|
||||
(ert-deftest ert-test-fail-debug-with-debugger-2 ()
|
||||
(let ((test (make-ert-test :body (lambda () (ert-fail "failure message")))))
|
||||
(block nil
|
||||
(let ((debugger (lambda (&rest debugger-args)
|
||||
(return-from nil nil))))
|
||||
(cl-block nil
|
||||
(let ((debugger (lambda (&rest _args)
|
||||
(cl-return-from nil nil))))
|
||||
(let ((ert-debug-on-error t))
|
||||
(ert-run-test test))
|
||||
(assert nil)))))
|
||||
(cl-assert nil)))))
|
||||
|
||||
(ert-deftest ert-test-fail-debug-nested-with-debugger ()
|
||||
(let ((test (make-ert-test :body (lambda ()
|
||||
(let ((ert-debug-on-error t))
|
||||
(ert-fail "failure message"))))))
|
||||
(let ((debugger (lambda (&rest debugger-args)
|
||||
(assert nil nil "Assertion a"))))
|
||||
(let ((debugger (lambda (&rest _args)
|
||||
(cl-assert nil nil "Assertion a"))))
|
||||
(let ((ert-debug-on-error nil))
|
||||
(ert-run-test test))))
|
||||
(let ((test (make-ert-test :body (lambda ()
|
||||
(let ((ert-debug-on-error nil))
|
||||
(ert-fail "failure message"))))))
|
||||
(block nil
|
||||
(let ((debugger (lambda (&rest debugger-args)
|
||||
(return-from nil nil))))
|
||||
(cl-block nil
|
||||
(let ((debugger (lambda (&rest _args)
|
||||
(cl-return-from nil nil))))
|
||||
(let ((ert-debug-on-error t))
|
||||
(ert-run-test test))
|
||||
(assert nil nil "Assertion b")))))
|
||||
(cl-assert nil nil "Assertion b")))))
|
||||
|
||||
(ert-deftest ert-test-error ()
|
||||
(let ((test (make-ert-test :body (lambda () (error "Error message")))))
|
||||
(let ((result (let ((ert-debug-on-error nil))
|
||||
(ert-run-test test))))
|
||||
(assert (ert-test-failed-p result) t)
|
||||
(assert (equal (ert-test-result-with-condition-condition result)
|
||||
(cl-assert (ert-test-failed-p result) t)
|
||||
(cl-assert (equal (ert-test-result-with-condition-condition result)
|
||||
'(error "Error message"))
|
||||
t))))
|
||||
|
||||
@ -153,9 +153,9 @@ failed or if there was a problem."
|
||||
(progn
|
||||
(let ((ert-debug-on-error t))
|
||||
(ert-run-test test))
|
||||
(assert nil))
|
||||
(cl-assert nil))
|
||||
((error)
|
||||
(assert (equal condition '(error "Error message")) t)))))
|
||||
(cl-assert (equal condition '(error "Error message")) t)))))
|
||||
|
||||
|
||||
;;; Test that `should' works.
|
||||
@ -163,13 +163,13 @@ failed or if there was a problem."
|
||||
(let ((test (make-ert-test :body (lambda () (should nil)))))
|
||||
(let ((result (let ((ert-debug-on-error nil))
|
||||
(ert-run-test test))))
|
||||
(assert (ert-test-failed-p result) t)
|
||||
(assert (equal (ert-test-result-with-condition-condition result)
|
||||
(cl-assert (ert-test-failed-p result) t)
|
||||
(cl-assert (equal (ert-test-result-with-condition-condition result)
|
||||
'(ert-test-failed ((should nil) :form nil :value nil)))
|
||||
t)))
|
||||
(let ((test (make-ert-test :body (lambda () (should t)))))
|
||||
(let ((result (ert-run-test test)))
|
||||
(assert (ert-test-passed-p result) t))))
|
||||
(cl-assert (ert-test-passed-p result) t))))
|
||||
|
||||
(ert-deftest ert-test-should-value ()
|
||||
(should (eql (should 'foo) 'foo))
|
||||
@ -179,17 +179,18 @@ failed or if there was a problem."
|
||||
(let ((test (make-ert-test :body (lambda () (should-not t)))))
|
||||
(let ((result (let ((ert-debug-on-error nil))
|
||||
(ert-run-test test))))
|
||||
(assert (ert-test-failed-p result) t)
|
||||
(assert (equal (ert-test-result-with-condition-condition result)
|
||||
(cl-assert (ert-test-failed-p result) t)
|
||||
(cl-assert (equal (ert-test-result-with-condition-condition result)
|
||||
'(ert-test-failed ((should-not t) :form t :value t)))
|
||||
t)))
|
||||
(let ((test (make-ert-test :body (lambda () (should-not nil)))))
|
||||
(let ((result (ert-run-test test)))
|
||||
(assert (ert-test-passed-p result)))))
|
||||
(cl-assert (ert-test-passed-p result)))))
|
||||
|
||||
|
||||
(ert-deftest ert-test-should-with-macrolet ()
|
||||
(let ((test (make-ert-test :body (lambda ()
|
||||
(macrolet ((foo () `(progn t nil)))
|
||||
(cl-macrolet ((foo () `(progn t nil)))
|
||||
(should (foo)))))))
|
||||
(let ((result (let ((ert-debug-on-error nil))
|
||||
(ert-run-test test))))
|
||||
@ -303,32 +304,33 @@ This macro is used to test if macroexpansion in `should' works."
|
||||
|
||||
(ert-deftest ert-test-should-failure-debugging ()
|
||||
"Test that `should' errors contain the information we expect them to."
|
||||
(loop for (body expected-condition) in
|
||||
`((,(lambda () (let ((x nil)) (should x)))
|
||||
(ert-test-failed ((should x) :form x :value nil)))
|
||||
(,(lambda () (let ((x t)) (should-not x)))
|
||||
(ert-test-failed ((should-not x) :form x :value t)))
|
||||
(,(lambda () (let ((x t)) (should (not x))))
|
||||
(ert-test-failed ((should (not x)) :form (not t) :value nil)))
|
||||
(,(lambda () (let ((x nil)) (should-not (not x))))
|
||||
(ert-test-failed ((should-not (not x)) :form (not nil) :value t)))
|
||||
(,(lambda () (let ((x t) (y nil)) (should-not
|
||||
(ert--test-my-list x y))))
|
||||
(ert-test-failed
|
||||
((should-not (ert--test-my-list x y))
|
||||
:form (list t nil)
|
||||
:value (t nil))))
|
||||
(,(lambda () (let ((x t)) (should (error "Foo"))))
|
||||
(error "Foo")))
|
||||
do
|
||||
(let ((test (make-ert-test :body body)))
|
||||
(condition-case actual-condition
|
||||
(progn
|
||||
(let ((ert-debug-on-error t))
|
||||
(ert-run-test test))
|
||||
(assert nil))
|
||||
((error)
|
||||
(should (equal actual-condition expected-condition)))))))
|
||||
(cl-loop
|
||||
for (body expected-condition) in
|
||||
`((,(lambda () (let ((x nil)) (should x)))
|
||||
(ert-test-failed ((should x) :form x :value nil)))
|
||||
(,(lambda () (let ((x t)) (should-not x)))
|
||||
(ert-test-failed ((should-not x) :form x :value t)))
|
||||
(,(lambda () (let ((x t)) (should (not x))))
|
||||
(ert-test-failed ((should (not x)) :form (not t) :value nil)))
|
||||
(,(lambda () (let ((x nil)) (should-not (not x))))
|
||||
(ert-test-failed ((should-not (not x)) :form (not nil) :value t)))
|
||||
(,(lambda () (let ((x t) (y nil)) (should-not
|
||||
(ert--test-my-list x y))))
|
||||
(ert-test-failed
|
||||
((should-not (ert--test-my-list x y))
|
||||
:form (list t nil)
|
||||
:value (t nil))))
|
||||
(,(lambda () (let ((_x t)) (should (error "Foo"))))
|
||||
(error "Foo")))
|
||||
do
|
||||
(let ((test (make-ert-test :body body)))
|
||||
(condition-case actual-condition
|
||||
(progn
|
||||
(let ((ert-debug-on-error t))
|
||||
(ert-run-test test))
|
||||
(cl-assert nil))
|
||||
((error)
|
||||
(should (equal actual-condition expected-condition)))))))
|
||||
|
||||
(ert-deftest ert-test-deftest ()
|
||||
(should (equal (macroexpand '(ert-deftest abc () "foo" :tags '(bar)))
|
||||
@ -520,7 +522,7 @@ This macro is used to test if macroexpansion in `should' works."
|
||||
(setf (cdr (last a)) (cddr a))
|
||||
(should (not (ert--proper-list-p a))))
|
||||
(let ((a (list 1 2 3 4)))
|
||||
(setf (cdr (last a)) (cdddr a))
|
||||
(setf (cdr (last a)) (cl-cdddr a))
|
||||
(should (not (ert--proper-list-p a)))))
|
||||
|
||||
(ert-deftest ert-test-parse-keys-and-body ()
|
||||
@ -657,14 +659,14 @@ This macro is used to test if macroexpansion in `should' works."
|
||||
(i 0))
|
||||
(let ((result (ert--remove-if-not (lambda (x)
|
||||
(should (eql x (nth i list)))
|
||||
(incf i)
|
||||
(cl-incf i)
|
||||
(member i '(2 3)))
|
||||
list)))
|
||||
(should (equal i 4))
|
||||
(should (equal result '(b c)))
|
||||
(should (equal list '(a b c d)))))
|
||||
(should (equal '()
|
||||
(ert--remove-if-not (lambda (x) (should nil)) '()))))
|
||||
(ert--remove-if-not (lambda (_x) (should nil)) '()))))
|
||||
|
||||
(ert-deftest ert-test-remove* ()
|
||||
(let ((list (list 'a 'b 'c 'd))
|
||||
@ -676,13 +678,13 @@ This macro is used to test if macroexpansion in `should' works."
|
||||
(should (eql x (nth key-index list)))
|
||||
(prog1
|
||||
(list key-index x)
|
||||
(incf key-index)))
|
||||
(cl-incf key-index)))
|
||||
:test
|
||||
(lambda (a b)
|
||||
(should (eql a 'foo))
|
||||
(should (equal b (list test-index
|
||||
(nth test-index list))))
|
||||
(incf test-index)
|
||||
(cl-incf test-index)
|
||||
(member test-index '(2 3))))))
|
||||
(should (equal key-index 4))
|
||||
(should (equal test-index 4))
|
||||
|
||||
@ -28,7 +28,7 @@
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
(require 'cl-lib))
|
||||
(require 'ert)
|
||||
(require 'ert-x)
|
||||
|
||||
@ -233,8 +233,8 @@ desired effect."
|
||||
(should (equal (buffer-string) ""))
|
||||
(let ((message-log-max 2))
|
||||
(let ((message-log-max t))
|
||||
(loop for i below 4 do
|
||||
(message "%s" i))
|
||||
(cl-loop for i below 4 do
|
||||
(message "%s" i))
|
||||
(should (equal (buffer-string) "0\n1\n2\n3\n")))
|
||||
(should (equal (buffer-string) "0\n1\n2\n3\n"))
|
||||
(message "")
|
||||
@ -244,28 +244,28 @@ desired effect."
|
||||
|
||||
(ert-deftest ert-test-force-message-log-buffer-truncation ()
|
||||
:tags '(:causes-redisplay)
|
||||
(labels ((body ()
|
||||
(loop for i below 3 do
|
||||
(message "%s" i)))
|
||||
;; Uses the implicit messages buffer truncation implemented
|
||||
;; in Emacs' C core.
|
||||
(c (x)
|
||||
(ert-with-buffer-renamed ("*Messages*")
|
||||
(let ((message-log-max x))
|
||||
(body))
|
||||
(with-current-buffer "*Messages*"
|
||||
(buffer-string))))
|
||||
;; Uses our lisp reimplementation.
|
||||
(lisp (x)
|
||||
(ert-with-buffer-renamed ("*Messages*")
|
||||
(let ((message-log-max t))
|
||||
(body))
|
||||
(let ((message-log-max x))
|
||||
(ert--force-message-log-buffer-truncation))
|
||||
(with-current-buffer "*Messages*"
|
||||
(buffer-string)))))
|
||||
(loop for x in '(0 1 2 3 4 t) do
|
||||
(should (equal (c x) (lisp x))))))
|
||||
(cl-labels ((body ()
|
||||
(cl-loop for i below 3 do
|
||||
(message "%s" i)))
|
||||
;; Uses the implicit messages buffer truncation implemented
|
||||
;; in Emacs' C core.
|
||||
(c (x)
|
||||
(ert-with-buffer-renamed ("*Messages*")
|
||||
(let ((message-log-max x))
|
||||
(body))
|
||||
(with-current-buffer "*Messages*"
|
||||
(buffer-string))))
|
||||
;; Uses our lisp reimplementation.
|
||||
(lisp (x)
|
||||
(ert-with-buffer-renamed ("*Messages*")
|
||||
(let ((message-log-max t))
|
||||
(body))
|
||||
(let ((message-log-max x))
|
||||
(ert--force-message-log-buffer-truncation))
|
||||
(with-current-buffer "*Messages*"
|
||||
(buffer-string)))))
|
||||
(cl-loop for x in '(0 1 2 3 4 t) do
|
||||
(should (equal (c x) (lisp x))))))
|
||||
|
||||
|
||||
(provide 'ert-x-tests)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user