commit c1145c31adf143460911dd87b408d35ea88a1a92 (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Sun Dec 5 23:13:06 2021 -0800 Update org-compat doc string * lisp/org/org-compat.el (file-attribute-modification-time): Update doc string to match that of builtin Emacs. diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index d230ee2b11..b140df7622 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -170,8 +170,7 @@ extension beyond end of line was not controllable." (defsubst file-attribute-modification-time (attributes) "The modification time in ATTRIBUTES returned by `file-attributes'. This is the time of the last change to the file's contents, and -is a list of integers (HIGH LOW USEC PSEC) in the same style -as (current-time)." +is a Lisp timestamp in the same style as `current-time'." (nth 5 attributes))) (unless (fboundp 'file-attribute-size) commit a21b8c5d7dfb3808cf18a5ac118e25940c9b5518 Author: Paul Eggert Date: Sun Dec 5 23:00:10 2021 -0800 Fix minor clock skew issues * lisp/midnight.el (clean-buffer-list): * lisp/progmodes/vhdl-mode.el (vhdl-template-replace-header-keywords): * lisp/net/rcirc.el (rcirc-connect): Don’t assume that getting the current time twice in rapid succession will yield the same date and time. diff --git a/lisp/midnight.el b/lisp/midnight.el index b3adbf0017..51173e7429 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el @@ -159,7 +159,7 @@ the current date/time, buffer name, how many seconds ago it was displayed (can be nil if the buffer was never displayed) and its lifetime, i.e., its \"age\" when it will be purged." (interactive) - (let ((tm (current-time)) bts (ts (format-time-string "%Y-%m-%d %T")) + (let* ((tm (current-time)) bts (ts (format-time-string "%Y-%m-%d %T" tm)) delay cbld bn) (dolist (buf (buffer-list)) (when (buffer-live-p buf) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index b4e9031e0d..2375b14cca 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -716,8 +716,8 @@ that are joined after authentication." (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)) + (setq rcirc-last-server-message-time rcirc-last-connect-time) ;; Check if the immediate process state (sit-for .1) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 3a9185b334..f3a7d96c63 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -10683,8 +10683,9 @@ Include a library specification, if not already there." (replace-match "" t t) (vhdl-template-insert-date)) (goto-char beg) - (while (search-forward "" end t) - (replace-match (format-time-string "%Y" nil) t t)) + (let ((year (format-time-string "%Y"))) + (while (search-forward "" end t) + (replace-match year t t))) (goto-char beg) (when file-title (while (search-forward "" end t) commit 19932c32039b8e61486195504a72bfc037b29658 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 22:56:49 2021 -0800 Avoid timestamp info loss in mh-alias-tstamp * lisp/mh-e/mh-alias.el (mh-alias-tstamp): Don’t lose subsecond info when setting mh-alias-tstamp. diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index 8087df97c9..d266621100 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -67,8 +67,7 @@ Return t if any file listed in the Aliasfile MH profile component has been modified since the timestamp. If ARG is non-nil, set timestamp with the current time." (if arg - (let ((time (current-time))) - (setq mh-alias-tstamp (list (nth 0 time) (nth 1 time)))) + (setq mh-alias-tstamp (current-time)) (let ((stamp)) (car (memq t (mapcar (lambda (file) commit dbef2145c78a8b6cd913d677e50a0b7df0b1b831 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 22:52:26 2021 -0800 Simplify by using format-time-string * lisp/mail/sendmail.el (mail-do-fcc): * lisp/net/tramp.el (tramp-debug-message): Prefer format-time-string to doing time formatting by hand. diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index d0aff093df..d1e8a2f3c6 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1391,8 +1391,7 @@ just append to the file, in Babyl format if necessary." (unless (markerp header-end) (error "Value of `header-end' must be a marker")) (let (fcc-list - (mailbuf (current-buffer)) - (time (current-time))) + (mailbuf (current-buffer))) (save-excursion (goto-char (point-min)) (let ((case-fold-search t)) @@ -1408,14 +1407,11 @@ just append to the file, in Babyl format if necessary." (with-temp-buffer ;; This initial newline is not written out if we create a new ;; file (see below). - (insert "\nFrom " (user-login-name) " " (current-time-string time) "\n") - ;; Insert the time zone before the year. - (forward-char -1) - (forward-word-strictly -1) (require 'mail-utils) - (insert (mail-rfc822-time-zone time) " ") - (goto-char (point-max)) - (insert "Date: " (message-make-date) "\n") + (insert "\nFrom " (user-login-name) " " + (let ((system-time-locale "C")) + (format-time-string "%a %b %e %T %z %Y")) + "\nDate: " (message-make-date) "\n") (insert-buffer-substring mailbuf) ;; Make sure messages are separated. (goto-char (point-max)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f43c1d84b8..552788b461 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2014,9 +2014,7 @@ ARGUMENTS to actually emit the message (if applicable)." (unless (bolp) (insert "\n")) ;; Timestamp. - (let ((now (current-time))) - (insert (format-time-string "%T." now)) - (insert (format "%06d " (nth 2 now)))) + (insert (format-time-string "%T.%6N ")) ;; Calling Tramp function. We suppress compat and trace ;; functions from being displayed. (let ((btn 1) btf fn) commit 15f20c0bd06a25bbb4ea90e501ef85290509c43b Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 22:43:55 2021 -0800 Simplify RFC 5322 time zone generation * lisp/mail/feedmail.el (feedmail-rfc822-time-zone) (feedmail-rfc822-date, feedmail-default-message-id-generator): * lisp/mail/mail-utils.el (mail-rfc822-time-zone, mail-rfc822-date): * lisp/timezone.el (timezone-make-arpa-date): Simplify by using format-time-string with %z. * lisp/mail/feedmail.el (feedmail-rfc822-time-zone): * lisp/mail/mail-utils.el (mail-rfc822-time-zone): Mark these should-have-been-internal functions obsolete. diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index fe686cb6f8..32edc29261 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -2336,19 +2336,14 @@ mapped to mostly alphanumerics for safety." ;; from a similar function in mail-utils.el (defun feedmail-rfc822-time-zone (time) + (declare (obsolete format-time-string "29.1")) (feedmail-say-debug ">in-> feedmail-rfc822-time-zone %s" time) - (let* ((sec (or (car (current-time-zone time)) 0)) - (absmin (/ (abs sec) 60))) - (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60)))) + (format-time-string "%z" time)) (defun feedmail-rfc822-date (arg-time) (feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time) - (let ((time (or arg-time (current-time))) - (system-time-locale "C")) - (concat - (format-time-string "%a, %e %b %Y %T " time) - (feedmail-rfc822-time-zone time) - ))) + (let ((system-time-locale "C")) + (format-time-string "%a, %e %b %Y %T %z" arg-time))) (defun feedmail-send-it-immediately-wrapper () "Wrapper to catch skip-me-i." @@ -2847,10 +2842,9 @@ probably not appropriate for you." (if (and (not feedmail-queue-use-send-time-for-message-id) maybe-file) (setq date-time (file-attribute-modification-time (file-attributes maybe-file)))) - (format "<%d-%s%s%s>" + (format "<%d-%s%s>" (mod (random) 10000) - (format-time-string "%a%d%b%Y%H%M%S" date-time) - (feedmail-rfc822-time-zone date-time) + (format-time-string "%a%d%b%Y%H%M%S%z" date-time) end-stuff)) ) diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index 3eb3ccb93d..f1b0590bec 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -368,19 +368,12 @@ matches may be returned from the message body." labels) (defun mail-rfc822-time-zone (time) - (let* ((sec (or (car (current-time-zone time)) 0)) - (absmin (/ (abs sec) 60))) - (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60)))) + (declare (obsolete format-time-string "29.1")) + (format-time-string "%z" time)) (defun mail-rfc822-date () - (let* ((time (current-time)) - (s (current-time-string time))) - (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s) - (concat (substring s (match-beginning 2) (match-end 2)) " " - (substring s (match-beginning 1) (match-end 1)) " " - (substring s (match-beginning 4) (match-end 4)) " " - (substring s (match-beginning 3) (match-end 3)) " " - (mail-rfc822-time-zone time)))) + (let ((system-time-locale "C")) + (format-time-string "%-d %b %Y %T %z"))) (defun mail-mbox-from () "Return an mbox \"From \" line for the current message. diff --git a/lisp/timezone.el b/lisp/timezone.el index 2c96343a74..0fcdbdbc16 100644 --- a/lisp/timezone.el +++ b/lisp/timezone.el @@ -95,10 +95,7 @@ if nil, the local time zone is assumed." Optional argument TIMEZONE specifies a time zone." (let ((zone (if (listp timezone) - (let* ((m (timezone-zone-to-minute timezone)) - (absm (if (< m 0) (- m) m))) - (format "%c%02d%02d" - (if (< m 0) ?- ?+) (/ absm 60) (% absm 60))) + (format-time-string "%z" 0 (or timezone 0)) timezone))) (format "%02d %s %04d %s %s" day commit 186637314dfa287b4b8178b668de92ecb57fdf1a Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 19:30:27 2021 -0800 Fix image load timekeeping bug * lisp/image.el (image-animate-timeout): Fix bug that caused the local variable time-to-load-image to be practically zero, instead of the time it actually took to load the image. I think this bug was introduced in 2013-02-16T03:29:30Z!rgm@gnu.org. diff --git a/lisp/image.el b/lisp/image.el index 87fab80aad..cedefc038f 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -953,9 +953,9 @@ for the animation speed. A negative value means to animate in reverse." (progn (message "Stopping animation; animation possibly too big") nil))) - (image-show-frame image n t) - (let* ((speed (image-animate-get-speed image)) - (time (current-time)) + (let* ((time (prog1 (current-time) + (image-show-frame image n t))) + (speed (image-animate-get-speed image)) (time-to-load-image (time-since time)) (stated-delay-time (/ (or (cdr (plist-get (cdr image) :animate-multi-frame-data)) commit 2bda02943b555b184f09dd1a5882e04a288f5026 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 19:11:59 2021 -0800 Use time-convert in with-decoded-time-value * lisp/calendar/time-date.el (with-decoded-time-value): Prefer time-convert to current-time on the off chance that code will use this obsolete macro even after current-time returns pairs. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 37a16d3b98..b36171259c 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -69,7 +69,7 @@ list (HIGH LOW MICRO PICO)." (pop elt))) (time-value (car elt)) (gensym (make-symbol "time"))) - `(let* ,(append `((,gensym (or ,time-value (current-time))) + `(let* ,(append `((,gensym (or ,time-value (time-convert nil 'list))) (,gensym (cond ((integerp ,gensym) commit 084f440571694ec14ea5def4191861bdb5854ea0 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 18:39:28 2021 -0800 Simplify message-make-expires * lisp/gnus/message.el (message-make-expires): Use time-add instead of doing it by hand. This also calculates the expiration time more accurately than the old code did. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 8e7983a33c..c2d14296f9 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5948,12 +5948,9 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (defun message-make-expires () "Return an Expires header based on `message-expires'." - (let ((current (current-time)) - (future (* 1.0 message-expires 60 60 24))) + (let ((future (* 60 60 24 message-expires))) ;; Add the future to current. - (setcar current (+ (car current) (round (/ future (expt 2 16))))) - (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) - (message-make-date current))) + (message-make-date (time-add nil future)))) (defun message-make-path () "Return uucp path." commit f4d7ca73e3ab975fd920a2b0f2d1a7fdb5276d99 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 18:35:27 2021 -0800 Simplify message-unique-id etc. * lisp/gnus/message.el (message-unique-id): * lisp/net/sasl.el (sasl-unique-id-function): Avoid unnecessary consing and reliance on internal timestamp format by using (time-convert nil 'integer) which typically does no consing, instead of using (current-time) and then ignoring the subsecond parts of the generated list. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 562bc64f6f..8e7983a33c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5828,15 +5828,15 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." ;; You might for example insert a "." somewhere (not next to another dot ;; or string boundary), or modify the "fsf" string. (defun message-unique-id () - ;; Don't use microseconds from (current-time), they may be unsupported. + ;; Don't use fractional seconds from timestamp; they may be unsupported. ;; Instead we use this randomly inited counter. (setq message-unique-id-char - (% (1+ (or message-unique-id-char - (random (ash 1 20)))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (current-time))) + ;; 2^16 * 25 just fits into 4 digits i base 36. + (let ((base (* 25 25))) + (if message-unique-id-char + (% (1+ message-unique-id-char) base) + (random base)))) + (let ((tm (time-convert nil 'integer))) (concat (if (or (eq system-type 'ms-dos) ;; message-number-base36 doesn't handle bigints. @@ -5846,10 +5846,12 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (aset user (match-beginning 0) ?_)) user) (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) - (ash (% message-unique-id-char 25) 16)) 4) - (message-number-base36 (+ (nth 1 tm) - (ash (/ message-unique-id-char 25) 16)) 4) + (message-number-base36 (+ (ash tm -16) + (ash (% message-unique-id-char 25) 16)) + 4) + (message-number-base36 (+ (logand tm #xffff) + (ash (/ message-unique-id-char 25) 16)) + 4) ;; Append a given name, because while the generated ID is unique ;; to this newsreader, other newsreaders might otherwise generate ;; the same ID via another algorithm. diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index b7f814f723..0a3ecf9f53 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -174,21 +174,24 @@ It contain at least 64 bits of entropy." ;; stolen (and renamed) from message.el (defun sasl-unique-id-function () - ;; Don't use microseconds from (current-time), they may be unsupported. + ;; Don't use fractional seconds from timestamp; they may be unsupported. ;; Instead we use this randomly inited counter. (setq sasl-unique-id-char - (% (1+ (or sasl-unique-id-char (logand (random) (1- (ash 1 20))))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (current-time))) + ;; 2^16 * 25 just fits into 4 digits i base 36. + (let ((base (* 25 25))) + (if sasl-unique-id-char + (% (1+ sasl-unique-id-char) base) + (random base)))) + (let ((tm (time-convert nil 'integer))) (concat (sasl-unique-id-number-base36 - (+ (car tm) - (ash (% sasl-unique-id-char 25) 16)) 4) + (+ (ash tm -16) + (ash (% sasl-unique-id-char 25) 16)) + 4) (sasl-unique-id-number-base36 - (+ (nth 1 tm) - (ash (/ sasl-unique-id-char 25) 16)) 4)))) + (+ (logand tm #xffff) + (ash (/ sasl-unique-id-char 25) 16)) + 4)))) (defun sasl-unique-id-number-base36 (num len) (if (if (< len 0) commit 524c42fa0eb9e4bf02d39e4d04353a354a84cebc Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 18:25:46 2021 -0800 Prefer nil to (current-time) when either will do * lisp/emacs-lisp/timer.el (timer-event-handler, run-at-time): * lisp/gnus/gnus-score.el (gnus-score-date): * lisp/gnus/gnus-search.el (gnus-search-query-parse-date) (gnus-search-imap-handle-date): * lisp/gnus/gnus-sum.el (gnus-user-date) (gnus-summary-create-article): * lisp/image-dired.el (image-dired-create-thumb-1): * lisp/image/gravatar.el (gravatar-retrieve) (gravatar--prune-cache): * lisp/net/dbus.el (dbus-monitor-handler): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-set-file-times): * lisp/net/tramp-sh.el (tramp-sh-handle-set-file-times): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-handle-set-file-times): * test/lisp/autorevert-tests.el (auto-revert--wait-for-revert) (auto-revert-tests--write-file, auto-revert-test--wait-for): * test/lisp/net/tramp-tests.el (tramp--test-print-duration): Prefer nil to (current-time) when either will do, as this avoids some consing. Similarly, prefer omitting (current-time) arg when this is equivalent. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 6ffc057ba1..74b5fb442e 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -18048,7 +18048,7 @@ find all messages that have been received recently from certain groups: (list (cons 'query (format-time-string "SENTSINCE %d-%b-%Y" - (time-subtract (current-time) + (time-subtract nil (days-to-time (car args))))) (cons 'criteria ""))) (group-spec (cadr args))) diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 2ac2c99245..c7d02cc748 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -314,7 +314,7 @@ This function is called, by name, directly by the C code." (not (timer--idle-delay timer))) (setf (timer--time timer) (timer-next-integral-multiple-of-time - (current-time) (timer--repeat-delay timer)))) + nil (timer--repeat-delay timer)))) ;; Place it back on the timer-list before running ;; timer--function, so it can cancel-timer itself. (timer-activate timer t cell) @@ -391,7 +391,7 @@ This function returns a timer object which you can use in ;; Special case: t means the next integral multiple of REPEAT. (when (and (eq time t) repeat) - (setq time (timer-next-integral-multiple-of-time (current-time) repeat)) + (setq time (timer-next-integral-multiple-of-time nil repeat)) (setf (timer--integral-multiple timer) t)) ;; Handle numbers as relative times in seconds. diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index d031047804..a25673a0e7 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -1749,7 +1749,7 @@ score in `gnus-newsgroup-scored' by SCORE." (setq type 'after match-func 'string< match (gnus-time-iso8601 - (time-subtract (current-time) + (time-subtract nil (* 86400 (nth 0 kill)))))) ((eq type 'before) (setq match-func 'gnus-string> @@ -1758,7 +1758,7 @@ score in `gnus-newsgroup-scored' by SCORE." (setq type 'before match-func 'gnus-string> match (gnus-time-iso8601 - (time-subtract (current-time) + (time-subtract nil (* 86400 (nth 0 kill)))))) ((eq type 'at) (setq match-func 'string= diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index c77de688e6..a79c106062 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -572,9 +572,7 @@ REL-DATE, or (current-time) if REL-DATE is nil." ;; Time parsing doesn't seem to work with slashes. (let ((value (string-replace "/" "-" value)) (now (append '(0 0 0) - (seq-subseq (decode-time (or rel-date - (current-time))) - 3)))) + (seq-subseq (decode-time rel-date) 3)))) ;; Check for relative time parsing. (if (string-match "\\([[:digit:]]+\\)\\([dwmy]\\)" value) (seq-subseq @@ -1239,8 +1237,7 @@ nil (except that (dd nil yyyy) is not allowed). Massage those numbers into the most recent past occurrence of whichever date elements are present." (pcase-let ((`(,nday ,nmonth ,nyear) - (seq-subseq (decode-time (current-time)) - 3 6)) + (seq-subseq (decode-time) 3 6)) (`(,dday ,dmonth ,dyear) date)) (unless (and dday dmonth dyear) (unless dday (setq dday 1)) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index dcdf3d977d..ba61658600 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3968,10 +3968,9 @@ Returns \" ? \" if there's bad input or if another error occurs. Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." (condition-case () (let* ((messy-date (gnus-date-get-time messy-date)) - (now (current-time)) ;;If we don't find something suitable we'll use this one (my-format "%b %d '%y")) - (let* ((difference (time-subtract now messy-date)) + (let* ((difference (time-subtract nil messy-date)) (templist gnus-user-date-format-alist) (top (eval (caar templist) t))) (while (if (numberp top) (time-less-p top difference) (not top)) @@ -10496,7 +10495,6 @@ latter case, they will be copied into the relevant groups." "Create an article in a mail newsgroup." (interactive nil gnus-summary-mode) (let ((group gnus-newsgroup-name) - (now (current-time)) group-art) (unless (gnus-check-backend-function 'request-accept-article group) (error "%s does not support article importing" group)) @@ -10506,7 +10504,7 @@ latter case, they will be copied into the relevant groups." ;; This doesn't look like an article, so we fudge some headers. (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" - "Date: " (message-make-date now) "\n" + "Date: " (message-make-date) "\n" "Message-ID: " (message-make-message-id) "\n") (setq group-art (gnus-request-accept-article group nil t)) (kill-buffer (current-buffer))) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 0723804ff2..fe0c3b7c22 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -768,7 +768,7 @@ and remove the cached thumbnail files between each trial run.") (image-dired-debug-message (format-time-string "Generated thumbnails in %s.%3N seconds" - (time-subtract (current-time) + (time-subtract nil image-dired--generate-thumbs-start)))) (if (not (and (eq (process-status process) 'exit) (zerop (process-exit-status process)))) diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el index f6f056a2ba..87726a9b8c 100644 --- a/lisp/image/gravatar.el +++ b/lisp/image/gravatar.el @@ -277,7 +277,7 @@ where GRAVATAR is either an image descriptor, or the symbol ;; Store the image in the cache. (when image (setf (gethash mail-address gravatar--cache) - (cons (time-convert (current-time) 'integer) + (cons (time-convert nil 'integer) image))) (prog1 (apply callback (if data image 'error) cbargs) @@ -286,7 +286,7 @@ where GRAVATAR is either an image descriptor, or the symbol (defun gravatar--prune-cache () (let ((expired nil) - (time (- (time-convert (current-time) 'integer) + (time (- (time-convert nil 'integer) ;; Twelve hours. (* 12 60 60)))) (maphash (lambda (key val) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 3fff5398c0..411249767f 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -2102,7 +2102,7 @@ has been handled by this function." (interface (dbus-event-interface-name event)) (member (dbus-event-member-name event)) (arguments (dbus-event-arguments event)) - (time (time-to-seconds (current-time)))) + (time (float-time))) (save-excursion ;; Check for matching method-call. (goto-char (point-max)) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 22e31428a7..6d83ae59b0 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1595,7 +1595,7 @@ If FILE-SYSTEM is non-nil, return file system attributes." "%s" (if (or (null time) (tramp-compat-time-equal-p time tramp-time-doesnt-exist) (tramp-compat-time-equal-p time tramp-time-dont-know)) - (current-time) + nil time))))) (defun tramp-gvfs-handle-get-remote-uid (vec id-format) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8d106591af..8e66363f03 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1429,7 +1429,7 @@ of." (if (or (null time) (tramp-compat-time-equal-p time tramp-time-doesnt-exist) (tramp-compat-time-equal-p time tramp-time-dont-know)) - (current-time) + nil time))) (tramp-send-command-and-check v (format diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index c91bced656..6da00f812d 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -534,7 +534,7 @@ the result will be a local, non-Tramp, file name." (if (or (null time) (tramp-compat-time-equal-p time tramp-time-doesnt-exist) (tramp-compat-time-equal-p time tramp-time-dont-know)) - (current-time) + nil time))) (tramp-sudoedit-send-command v "env" "TZ=UTC" "touch" "-t" diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index b9d45324cb..b31f0a9afc 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -127,7 +127,7 @@ This expects `auto-revert--messages' to be bound by `ert-with-message-capture' before calling." ;; Remote files do not cooperate well with timers. So we count ourselves. (let ((ct (current-time))) - (while (and (< (float-time (time-subtract (current-time) ct)) + (while (and (< (float-time (time-subtract nil ct)) (auto-revert--timeout)) (null (string-match (format-message @@ -167,7 +167,7 @@ This expects `auto-revert--messages' to be bound by (defun auto-revert-tests--write-file (text file time-delta &optional append) (write-region text nil file append 'no-message) - (set-file-times file (time-subtract (current-time) time-delta))) + (set-file-times file (time-subtract nil time-delta))) (ert-deftest auto-revert-test00-auto-revert-mode () "Check autorevert for a file." @@ -453,7 +453,7 @@ This expects `auto-revert--messages' to be bound by (defun auto-revert-test--wait-for (pred max-wait) "Wait until PRED is true, or MAX-WAIT seconds elapsed." (let ((ct (current-time))) - (while (and (< (float-time (time-subtract (current-time) ct)) max-wait) + (while (and (< (float-time (time-subtract nil ct)) max-wait) (not (funcall pred))) (read-event nil nil 0.1)))) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 47fa18eb80..c047f666da 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -241,7 +241,7 @@ is greater than 10. (progn ,@body) (tramp--test-message "%s %f sec" - ,message (float-time (time-subtract (current-time) start)))))) + ,message (float-time (time-subtract nil start)))))) ;; `always' is introduced with Emacs 28.1. (defalias 'tramp--test-always commit af6061894598efdcb1aeebbac2283d6e1d085820 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 17:58:11 2021 -0800 Simplify cedet-utest-elapsed-time * test/manual/cedet/cedet-utests.el (cedet-utest-elapsed-time): Copy newer (circa-2011) implementation from elp.el, so that the code matches its documentation again. diff --git a/test/manual/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el index d68b5b8c09..af6b4defb3 100644 --- a/test/manual/cedet/cedet-utests.el +++ b/test/manual/cedet/cedet-utests.el @@ -252,9 +252,7 @@ Optional argument TITLE is the title of this testing session." (defun cedet-utest-elapsed-time (start end) "Copied from elp.el. Was elp-elapsed-time. Argument START and END bound the time being calculated." - (+ (* (- (car end) (car start)) 65536.0) - (- (car (cdr end)) (car (cdr start))) - (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0))) + (float-time (time-subtract start end))) (defun cedet-utest-log-shutdown (title &optional _errorcondition) "Shut-down a larger test suite. commit 83fa35bb16a219faba6f2c793dd0fce83833a5ec Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 17:44:02 2021 -0800 Use time-equal-p to compare timestamps in tests * test/lisp/calendar/time-date-tests.el (test-days-to-time) (test-time-since): Use time-equal-p to compare timestamps, since the default form shouldn’t matter. diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index d5269804ad..ed842e34fd 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -55,13 +55,13 @@ (should (date-leap-year-p 2004))) (ert-deftest test-days-to-time () - (should (equal (days-to-time 0) '(0 0))) - (should (equal (days-to-time 1) '(1 20864))) - (should (equal (days-to-time 999) '(1317 2688))) - (should (equal (days-to-time 0.0) '(0 0 0 0))) - (should (equal (days-to-time 0.5) '(0 43200 0 0))) - (should (equal (days-to-time 1.0) '(1 20864 0 0))) - (should (equal (days-to-time 999.0) '(1317 2688 0 0)))) + (should (time-equal-p (days-to-time 0) '(0 0))) + (should (time-equal-p (days-to-time 1) '(1 20864))) + (should (time-equal-p (days-to-time 999) '(1317 2688))) + (should (time-equal-p (days-to-time 0.0) '(0 0 0 0))) + (should (time-equal-p (days-to-time 0.5) '(0 43200 0 0))) + (should (time-equal-p (days-to-time 1.0) '(1 20864 0 0))) + (should (time-equal-p (days-to-time 999.0) '(1317 2688 0 0)))) (ert-deftest test-seconds-to-string () (should (equal (seconds-to-string 0) "0s")) @@ -170,7 +170,8 @@ (ert-deftest test-time-since () (should (time-equal-p 0 (time-since nil))) - (should (= (cadr (time-since (time-subtract (current-time) 1))) 1))) + (should (time-equal-p 1 (time-convert (time-since (time-subtract nil 1)) + 'integer)))) (ert-deftest test-time-decoded-period () (should (equal (decoded-time-period '(nil nil 1 nil nil nil nil nil nil)) commit 0d88c3c340ec09f449a2a843205cdcabae799fe1 Author: Paul Eggert <eggert@cs.ucla.edu> Date: Sun Dec 5 17:38:58 2021 -0800 Add time-convert tests * test/src/timefns-tests.el (time-convert-forms): New test. diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el index bba9b3fcd8..f801478a9a 100644 --- a/test/src/timefns-tests.el +++ b/test/src/timefns-tests.el @@ -242,4 +242,16 @@ a fixed place on the right and are padded on the left." (should (= xdiv (float-time (time-convert xdiv t)))))) (setq x (* x 2))))) +(ert-deftest time-convert-forms () + ;; These computations involve numbers that should have exact + ;; representations on any Emacs platform. + (dolist (time '(-86400 -1 0 1 86400)) + (dolist (delta '(0 0.0 0.25 3.25 1000 1000.25)) + (let ((time+ (+ time delta)) + (time- (- time delta))) + (dolist (form '(nil t list 4 1000 1000000 1000000000)) + (should (time-equal-p time (time-convert time form))) + (should (time-equal-p time- (time-convert time- form))) + (should (time-equal-p time+ (time-convert time+ form)))))))) + ;;; timefns-tests.el ends here commit 4434deaee2aa9d8c6b9631690c6376f78a9b057f Author: NightMachinary <rudiwillalwaysloveyou@gmail.com> Date: Tue Nov 9 16:19:45 2021 +0330 Added dired-create-destination-dirs-on-trailing-dirsep * lisp/dired-aux.el (dired-create-destination-dirs-on-trailing-dirsep): New customization option. (dired-do-create-files): Use it. (dired-create-destination-dirs): Mention the new option in the docstring. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 588551a641..af7b160c1a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1787,13 +1787,46 @@ Special value `always' suppresses confirmation." "Whether Dired should create destination dirs when copying/removing files. If nil, don't create them. If `always', create them without asking. -If `ask', ask for user confirmation." +If `ask', ask for user confirmation. + +Also see `dired-create-destination-dirs-on-trailing-dirsep'." :type '(choice (const :tag "Never create non-existent dirs" nil) (const :tag "Always create non-existent dirs" always) (const :tag "Ask for user confirmation" ask)) :group 'dired :version "27.1") +(defcustom dired-create-destination-dirs-on-trailing-dirsep nil + "If non-nil, treat a trailing slash at queried destination dir specially. + +If this variable is non-nil and a single destination filename is +queried which ends in a directory separator (/), it will be +treated as a non-existent directory and acted on according to +`dired-create-destination-dirs'. + +This option is only relevant if `dired-create-destination-dirs' +is non-nil, too. + +For example, if both `dired-create-destination-dirs' and this +option are non-nil, renaming a directory named `old_name' to +`new_name/' (note the trailing directory separator) where +`new_name' does not exists already, it will be created and +`old_name' be moved into it. If only `new_name' (without the +trailing /) is given or this option or +`dired-create-destination-dirs' is `nil', `old_name' will be +renamed to `new_name'." + :type '(choice + (const :tag + (concat "Do not treat destination dirs with a " + "trailing directory separator specially") + nil) + (const :tag + (concat "Treat destination dirs with trailing " + "directory separator specially") + t)) + :group 'dired + :version "29.1") + (defun dired-maybe-create-dirs (dir) "Create DIR if doesn't exist according to `dired-create-destination-dirs'." (when (and dired-create-destination-dirs (not (file-exists-p dir))) @@ -2163,7 +2196,12 @@ Optional arg HOW-TO determines how to treat the target. target-dir op-symbol arg rfn-list default)))) (into-dir (progn - (unless dired-one-file (dired-maybe-create-dirs target)) + (when + (or + (not dired-one-file) + (and dired-create-destination-dirs-on-trailing-dirsep + (directory-name-p target))) + (dired-maybe-create-dirs target)) (cond ((null how-to) ;; Allow users to change the letter case of ;; a directory on a case-insensitive commit 013161d4a77658c501c05aa754d36164fceb3982 Merge: 0dca455d14 e3427faf55 Author: Stefan Kangas <stefan@marxist.se> Date: Mon Dec 6 06:47:44 2021 +0100 Merge from origin/emacs-28 e3427faf55 Fix typos and improve consistency in ERC manual 0bf10d5082 * test/Makefile.in (check-declare): Add missing --batch. 34f5656137 Document the subtleties of the 'cursor' text property commit 0dca455d1446eb7743594b3202b55e57615915c9 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Mon Dec 6 06:41:25 2021 +0100 Make the Git stash commands available in vc-dir Git buffers * lisp/vc/vc-dir.el (vc-dir): Call the backend-specific minor mode if it exists. * lisp/vc/vc-git.el (vc-dir-git-mode-map): New map. (vc-dir-git-mode): New minor mode. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 8165d5e09f..32e492171d 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1427,7 +1427,12 @@ These are the commands available for use in the file status buffer: (vc-dir-refresh) ;; FIXME: find a better way to pass the backend to `vc-dir-mode'. (let ((use-vc-backend backend)) - (vc-dir-mode)))) + (vc-dir-mode) + ;; Activate the backend-specific minor mode, if any. + (when-let ((minor-mode + (intern-soft (format "vc-dir-%s-mode" + (downcase (symbol-name backend)))))) + (funcall minor-mode 1))))) (defun vc-default-dir-extra-headers (_backend _dir) ;; Be loud by default to remind people to add code to display diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 08282647eb..3ceed365ee 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1872,6 +1872,16 @@ Returns nil if not possible." (1- (point-max))))))) (and name (not (string= name "undefined")) name)))) +(defvar-keymap vc-dir-git-mode-map + "z c" #'vc-git-stash + "z s" #'vc-git-stash-snapshot) + +(define-minor-mode vc-dir-git-mode + "A minor mode for git-specific commands in `vc-dir-mode' buffers. +Also note that there are git stash commands available in the +\"Stash\" section at the head of the buffer." + :lighter " Git") + (provide 'vc-git) ;;; vc-git.el ends here commit 9ab479b639c3efc56c7275b662fd0d5501cbfee2 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Mon Dec 6 04:29:43 2021 +0100 Make gnus-check-backend-function mode `debug-on-signal' friendly * lisp/gnus/gnus.el (gnus-check-backend-function): Allow running with `debug-on-signal'. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 56934dfa15..afe07ee46f 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3150,9 +3150,9 @@ g -- Group name." "Check whether GROUP supports function FUNC. GROUP can either be a string (a group name) or a select method." (ignore-errors - (let ((method (if (stringp group) - (car (gnus-find-method-for-group group)) - group))) + (when-let ((method (if (stringp group) + (car (gnus-find-method-for-group group)) + group))) (unless (featurep method) (require method)) (fboundp (intern (format "%s-%s" method func)))))) commit 2a73a52c4aa8b6a53c9ce3cd68e464bcd0d08d29 Author: Stefan Kangas <stefan@marxist.se> Date: Mon Dec 6 03:18:34 2021 +0100 ; Small doc fix in recent eieio-opt.el change * lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor): Quote functions to make links work in help-mode. diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 3297a9d2ec..680395387c 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -130,7 +130,7 @@ are not abstract." ;;;###autoload (defun eieio-help-constructor (ctr) "Describe CTR if it is a class constructor." - (declare (obsolete "use describe-function or cl--describe-class" "29.1")) + (declare (obsolete "use `describe-function' or `cl--describe-class'." "29.1")) (when (class-p ctr) (erase-buffer) (let ((location (find-lisp-object-file-name ctr 'define-type)) commit 9171061352a019acd5a4d6fef36cddfd78cf4ac1 Author: Stefan Monnier <monnier@iro.umontreal.ca> Date: Sun Dec 5 21:07:58 2021 -0500 EIEIO: Remove redundant type info in help `C-h o` returned redundant info when used on EIEIO classes, listing the same thing both for the type name and for the constructor name. * lisp/emacs-lisp/eieio.el (help-fns-describe-function-functions): Remove special case for defclass constructors. * lisp/emacs-lisp/eieio-opt.el (eieio-help-constructor): Declare it obsolete. diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 9c842f4682..3297a9d2ec 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -130,6 +130,7 @@ are not abstract." ;;;###autoload (defun eieio-help-constructor (ctr) "Describe CTR if it is a class constructor." + (declare (obsolete "use describe-function or cl--describe-class" "29.1")) (when (class-p ctr) (erase-buffer) (let ((location (find-lisp-object-file-name ctr 'define-type)) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 3fbfe011e2..2850c91ecd 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -992,11 +992,6 @@ of `eq'." (error "EIEIO: `change-class' is unimplemented")) (define-obsolete-function-alias 'change-class #'eieio-change-class "26.1") -;; Hook ourselves into help system for describing classes and methods. -;; FIXME: This is not actually needed any more since we can click on the -;; hyperlink from the constructor's docstring to see the type definition. -(add-hook 'help-fns-describe-function-functions #'eieio-help-constructor) - (provide 'eieio) ;;; eieio.el ends here commit 82f96ed38013a5bb78815c61ddecb2a21fb273b9 Author: Stefan Kangas <stefan@marxist.se> Date: Mon Dec 6 02:53:31 2021 +0100 image-dired: Use string-match-p in one case * lisp/image-dired.el (image-dired-get-thumbnail-image): Use string-match-p. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 0e597a515e..0723804ff2 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -540,7 +540,7 @@ Create the thumbnail directory if it does not exist." (defun image-dired-get-thumbnail-image (file) "Return the image descriptor for a thumbnail of image file FILE." - (unless (string-match (image-file-name-regexp) file) + (unless (string-match-p (image-file-name-regexp) file) (error "%s is not a valid image file" file)) (let* ((thumb-file (image-dired-thumb-name file)) (thumb-attr (file-attributes thumb-file))) commit fba7c8759520f9444923addee44de10657fa3ba7 Author: Stefan Kangas <stefan@marxist.se> Date: Mon Dec 6 02:48:55 2021 +0100 image-dired: Don't disable mouse dragging * lisp/image-dired.el (image-dired-thumbnail-mode-map): Don't disable mouse dragging. (Bug#52201) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 47a44a4a60..0e597a515e 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1593,11 +1593,6 @@ You probably want to use this together with (define-key map [down-mouse-1] #'image-dired-mouse-select-thumbnail) (define-key map [down-mouse-2] #'image-dired-mouse-select-thumbnail) (define-key map [down-mouse-3] #'image-dired-mouse-select-thumbnail) - ;; Let's disable mouse dragging, as it currently doesn't do - ;; anything useful. - (define-key map [drag-mouse-1] #'ignore) - (define-key map [drag-mouse-2] #'ignore) - (define-key map [drag-mouse-3] #'ignore) ;; Seems I must first set C-down-mouse-1 to undefined, or else it ;; will trigger the buffer menu. If I try to instead bind ;; C-down-mouse-1 to `image-dired-mouse-toggle-mark', I get a message commit e449f62a79f9acafd0b29df63e1cc177689b4407 Author: Po Lu <luangruo@yahoo.com> Date: Mon Dec 6 09:40:38 2021 +0800 Fix jittering when precision scrolling over images * lisp/pixel-scroll.el (pixel-scroll-precision-initial-velocity-factor): Default to nil. (pixel-scroll-precision-scroll-down-page): Always set window start. diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 7722984424..2e09f9af2d 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -133,7 +133,7 @@ This is only effective if supported by your mouse or touchpad." :type 'float :version "29.1") -(defcustom pixel-scroll-precision-large-scroll-height 70 +(defcustom pixel-scroll-precision-large-scroll-height nil "Pixels that must be scrolled before an animation is performed. Nil means to not interpolate such scrolls." :group 'mouse @@ -441,14 +441,13 @@ the height of the current window." (set-window-vscroll nil (+ (window-vscroll nil t) delta) t) - (unless (eq (window-start) desired-start) - (set-window-start nil (if (zerop (window-hscroll)) - desired-start - (save-excursion - (goto-char desired-start) - (beginning-of-visual-line) - (point))) - t)) + (set-window-start nil (if (zerop (window-hscroll)) + desired-start + (save-excursion + (goto-char desired-start) + (beginning-of-visual-line) + (point))) + t) (set-window-vscroll nil desired-vscroll t)) (if (and (or (< (point) next-pos)) (let ((pos-visibility (pos-visible-in-window-p next-pos nil t))) commit e6a0cfaad5365a129def0b348103233372a8fe49 Author: Justin Schell <justinmschell@gmail.com> Date: Mon Dec 6 02:27:52 2021 +0100 vc-git--program-version to support Git for macOS version string `git version` on macOS returns e.g., "git version 2.30.1 (Apple Git-130)" and `vc-git--program-version` currently returns "0" instead of "2.30.1". * lisp/vc/vc-git.el (vc-git--program-version): Ignore text after the version number when parsing git versions (bug#52172). Copyright-paperwork-exempt: yes diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 4b6cd93074..08282647eb 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -298,12 +298,14 @@ included in the completions." (vc-git--run-command-string nil "version"))) (setq vc-git--program-version (if (and version-string - ;; Git for Windows appends ".windows.N" to the - ;; numerical version reported by Git. - (string-match - "git version \\([0-9.]+\\)\\(\\.windows\\.[0-9]+\\)?$" - version-string)) - (match-string 1 version-string) + ;; Some Git versions append additional strings + ;; to the numerical version string. E.g., Git + ;; for Windows appends ".windows.N", while Git + ;; for Mac appends " (Apple Git-N)". Capture + ;; numerical version and ignore the rest. + (string-match "git version \\([0-9][0-9.]+\\)" + version-string)) + (string-trim-right (match-string 1 version-string) "\\.") "0"))))) (defun vc-git--git-status-to-vc-state (code-list) diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el new file mode 100644 index 0000000000..997ab3c4b5 --- /dev/null +++ b/test/lisp/vc/vc-git-tests.el @@ -0,0 +1,67 @@ +;;; vc-git-tests.el --- tests for vc/vc-git.el -*- lexical-binding:t -*- + +;; Copyright (C) 2016-2021 Free Software Foundation, Inc. + +;; Author: Justin Schell <justinmschell@gmail.com> +;; Maintainer: emacs-devel@gnu.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'vc-git) + +(ert-deftest vc-git-test-program-version-general () + (vc-git-test--run-program-version-test + "git version 2.30.1.0" + "2.30.1.0")) + +(ert-deftest vc-git-test-program-version-windows () + (vc-git-test--run-program-version-test + "git version 2.30.1.1.windows.1" + "2.30.1.1")) + +(ert-deftest vc-git-test-program-version-apple () + (vc-git-test--run-program-version-test + "git version 2.30.1.2 (Apple Git-130)" + "2.30.1.2")) + +(ert-deftest vc-git-test-program-version-other () + (vc-git-test--run-program-version-test + "git version 2.30.1.3.foo.bar" + "2.30.1.3")) + +(ert-deftest vc-git-test-program-version-invalid-leading-string () + (vc-git-test--run-program-version-test + "git version foo.bar.2.30.1.4" + "0")) + +(ert-deftest vc-git-test-program-version-invalid-leading-dot () + (vc-git-test--run-program-version-test + "git version .2.30.1.5" + "0")) + +(defun vc-git-test--run-program-version-test + (mock-version-string expected-output) + (cl-letf* (((symbol-function 'vc-git--run-command-string) + (lambda (_file _args) mock-version-string)) + (vc-git--program-version nil) + (actual-output (vc-git--program-version))) + (should (equal actual-output expected-output)))) + +;;; vc-git-tests.el ends here commit 2454f9876d647453d5e0d8e4aa2260f9254978c8 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Mon Dec 6 02:23:02 2021 +0100 Don't fill byte-compilation warnings in batch mode * lisp/emacs-lisp/warnings.el (display-warning): Don't break up byte-compilation into several lines when in batch mode, because that makes it difficult for some tools to parse them (bug#52281). diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 36b275e2d3..1d061364a0 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -307,7 +307,9 @@ entirely by setting `warning-suppress-types' or 'type 'warning-suppress-log-warning 'warning-type type)) (funcall newline) - (when (and warning-fill-prefix (not (string-search "\n" message))) + (when (and warning-fill-prefix + (not (string-search "\n" message)) + (not noninteractive)) (let ((fill-prefix warning-fill-prefix) (fill-column warning-fill-column)) (fill-region start (point)))) commit 77de40aed31d7c12569d05474f85e1d70b55d35e Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Mon Dec 6 01:16:23 2021 +0100 Audit `string-match' usage in shr.el * lisp/net/shr.el (shr-descend): (shr-insert): (shr-expand-url): (shr-image-from-data): (shr-dom-print): (shr-parse-style): (shr-tag-object): (shr-tag-img): (shr-render-td-1): Prefer string-match-p and string-search over string-match where possible. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index ee0e824411..63522b02ac 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -582,7 +582,7 @@ size, and full-buffer size." (setq shr-warning "Not rendering the complete page because of too-deep nesting") (when style - (if (string-match "color\\|display\\|border-collapse" style) + (if (string-match-p "color\\|display\\|border-collapse" style) (setq shr-stylesheet (nconc (shr-parse-style style) shr-stylesheet)) (setq style nil))) @@ -685,7 +685,7 @@ size, and full-buffer size." (goto-char (point-max))))) (t (let ((font-start (point))) - (when (and (string-match "\\`[ \t\n\r]" text) + (when (and (string-match-p "\\`[ \t\n\r]" text) (not (bolp)) (not (eq (char-after (1- (point))) ? ))) (insert " ")) @@ -843,7 +843,7 @@ size, and full-buffer size." (cond ((zerop (length url)) (nth 3 base)) ((or (not base) - (string-match "\\`[a-z]*:" url)) + (string-match-p "\\`[a-z]*:" url)) ;; Absolute or empty URI url) ((eq (aref url 0) ?/) @@ -1028,7 +1028,7 @@ the mouse click event." (let ((param (match-string 4 data)) (payload (url-unhex-string (match-string 5 data)))) (when (and param - (string-match "^.*\\(;[ \t]*base64\\)$" param)) + (string-match-p "^.*\\(;[ \t]*base64\\)$" param)) (setq payload (ignore-errors (base64-decode-string payload)))) payload))) @@ -1345,7 +1345,7 @@ ones, in case fg and bg are nil." ;; Filter out blocked elements inside the SVG image. (not (setq url (dom-attr elem ':xlink:href))) (not shr-blocked-images) - (not (string-match shr-blocked-images url))) + (not (string-match-p shr-blocked-images url))) (insert " ") (shr-dom-print elem))))) (insert (format "</%s>" (dom-tag dom)))) @@ -1432,7 +1432,7 @@ ones, in case fg and bg are nil." (defun shr-parse-style (style) (when style (save-match-data - (when (string-match "\n" style) + (when (string-search "\n" style) (setq style (replace-match " " t t style)))) (let ((plist nil)) (dolist (elem (split-string style ";")) @@ -1491,7 +1491,7 @@ ones, in case fg and bg are nil." (let ((start (point)) url multimedia image) (when-let* ((type (dom-attr dom 'type))) - (when (string-match "\\`image/svg" type) + (when (string-match-p "\\`image/svg" type) (setq url (dom-attr dom 'data) image t))) (dolist (child (dom-non-text-children dom)) @@ -1654,7 +1654,7 @@ The preference is a float determined from `shr-prefer-media-type'." (list :width width :height height))))) ((or shr-inhibit-images (and shr-blocked-images - (string-match shr-blocked-images url))) + (string-match-p shr-blocked-images url))) (setq shr-start (point)) (shr-insert alt)) ((and (not shr-ignore-cache) @@ -2463,7 +2463,7 @@ flags that control whether to collect or render objects." (max-width 0) natural-width) (when style - (setq style (and (string-match "color" style) + (setq style (and (string-search "color" style) (shr-parse-style style)))) (when bgcolor (setq style (nconc (list (cons 'background-color bgcolor)) commit e3427faf55d7887de1dcba0fd027474ccbb5c214 (refs/remotes/origin/emacs-28) Author: Christer Enfors <christer.enfors@gmail.com> Date: Sun Dec 5 22:46:58 2021 +0100 Fix typos and improve consistency in ERC manual * doc/misc/erc.texi (Sample Session, Special Features, History): Fix typos and improve consistency. (Bug52318) diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 48dc1b609a..73e24a4b36 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -70,7 +70,7 @@ and modified without restriction. Getting Started -* Sample Session:: Example of connecting to the #emacs channel +* Sample Session:: Example of connecting to the @samp{#emacs} channel * Special Features:: Differences from standalone IRC clients Advanced Usage @@ -132,14 +132,15 @@ customize-variable @key{RET} erc-modules @key{RET}}. @section Sample Session This is an example ERC session which shows how to connect to the -#emacs channel on Libera.Chat. Another IRC channel on Libera.Chat -that may be of interest is #erc, which is a channel where ERC users -and developers hang out. These channels used to live on the Freenode -IRC network until June 2021, when they---along with the official IRC -channels of the GNU Project, the Free Software Foundation, and many -other free software communities---relocated to the Libera.Chat network -in the aftermath of changes in governance and policies of Freenode in -May and June 2021. GNU and FSF's announcements about this are at +@samp{#emacs} channel on Libera.Chat. Another IRC channel on +Libera.Chat that may be of interest is @samp{#erc}, which is a channel +where ERC users and developers hang out. These channels used to live +on the Freenode IRC network until June 2021, when they---along with +the official IRC channels of the GNU Project, the Free Software +Foundation, and many other free software communities---relocated to +the Libera.Chat network in the aftermath of changes in governance and +policies of Freenode in May and June 2021. GNU and FSF's +announcements about this are at @uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00005.html}, @uref{https://lists.gnu.org/archive/html/info-gnu/2021-06/msg00007.html}, and @@ -149,7 +150,7 @@ and @item Connect to Libera.Chat -Run @kbd{M-x erc}. Use ``irc.libera.chat as the IRC server, ``6667'' +Run @kbd{M-x erc}. Use ``irc.libera.chat'' as the IRC server, ``6667'' as the port, and choose a nickname. @item Get used to the interface @@ -264,7 +265,7 @@ new command in capital letters. If the connection goes away at some point, ERC will try to reconnect automatically. If it fails to reconnect, and you want to try to manually reestablish the connection at some later point, switch to an -ERC buffer and run the @code{/RECONNECT} command. +ERC buffer and run the @code{/RECONNECT} command. @end itemize @@ -931,7 +932,7 @@ over the project entirely.'' So we happily hacked away on ERC, and soon after (September 2001) released the next "stable" version, 2.1. -Most of the development of the new ERC happened on #emacs on +Most of the development of the new ERC happened on @samp{#emacs} on irc.openprojects.net. Over time, many people contributed code, ideas, bugfixes, and a lot of alpha/beta/gamma testing. commit 6620d03e3346a2358dc5e3f20fad1f59c74bc2f8 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Dec 5 23:31:36 2021 +0100 ; * src/image.c (webp_load): Minor stylistic fix-up to previous change * src/image.c (webp_load): Minor stylistic fix-up to previous change. diff --git a/src/image.c b/src/image.c index 709abc21aa..278446e37f 100644 --- a/src/image.c +++ b/src/image.c @@ -9007,7 +9007,7 @@ webp_load (struct frame *f, struct image *img) /* Validate the WebP image header. */ if (!WebPGetInfo (contents, size, NULL, NULL)) { - if (! NILP (file)) + if (!NILP (file)) image_error ("Not a WebP file: `%s'", file); else image_error ("Invalid header in WebP image data"); @@ -9030,7 +9030,7 @@ webp_load (struct frame *f, struct image *img) case VP8_STATUS_USER_ABORT: default: /* Error out in all other cases. */ - if (! NILP (file)) + if (!NILP (file)) image_error ("Error when interpreting WebP image data: `%s'", file); else image_error ("Error when interpreting WebP image data"); commit dd2a8468904c2da57b4f1efe812c31742b4ff6aa Author: dickmao <dick.r.chiang@gmail.com> Date: Sun Dec 5 23:29:51 2021 +0100 Add workaround to compilation warning in gcc 10.x in image.c * src/image.c (webp_load): Work around a (wrong) compiler warning in gcc 10.x (bug#52276). diff --git a/src/image.c b/src/image.c index b85c405487..709abc21aa 100644 --- a/src/image.c +++ b/src/image.c @@ -8970,7 +8970,7 @@ webp_load (struct frame *f, struct image *img) { ptrdiff_t size = 0; uint8_t *contents; - Lisp_Object file; + Lisp_Object file = Qnil; /* Open the WebP file. */ Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); @@ -9007,7 +9007,7 @@ webp_load (struct frame *f, struct image *img) /* Validate the WebP image header. */ if (!WebPGetInfo (contents, size, NULL, NULL)) { - if (NILP (specified_data)) + if (! NILP (file)) image_error ("Not a WebP file: `%s'", file); else image_error ("Invalid header in WebP image data"); @@ -9030,7 +9030,7 @@ webp_load (struct frame *f, struct image *img) case VP8_STATUS_USER_ABORT: default: /* Error out in all other cases. */ - if (NILP (specified_data)) + if (! NILP (file)) image_error ("Error when interpreting WebP image data: `%s'", file); else image_error ("Error when interpreting WebP image data"); commit d3d8a6ccda765632ec62c38623c87f0b9f66b55d Author: YugaEgo <yet@ego.team> Date: Sun Dec 5 22:18:18 2021 +0100 ; * etc/themes/manoj-dark-theme.el: Remove not defined face info-menu-5 * etc/themes/manoj-dark-theme.el (manoj-dark): Remove reference to face removed in 2005 (bug#52303). diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index f10b88507e..e80403f5b3 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -541,7 +541,6 @@ jarring angry fruit salad look to reduce eye fatigue.") '(ido-indicator ((t (:background "red1" :foreground "yellow1" :width condensed)))) '(ido-only-match ((t (:foreground "ForestGreen")))) '(ido-subdir ((t (:foreground "red1")))) - '(info-menu-5 ((t (:underline t)))) '(info-menu-header ((t (:bold t :weight bold)))) '(info-node ((t (:bold t :italic t :foreground "yellow")))) '(info-node ((t (:italic t :bold t :foreground "white" :slant italic :weight bold)))) commit a996ddb5e6157f8bc65f03c130ed6dcfe2707c69 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Dec 5 22:12:26 2021 +0100 Update comment about `declare-function' * lisp/subr.el (declare-function): Fix comment -- `byte-compile-declare-function' doesn't exist. diff --git a/lisp/subr.el b/lisp/subr.el index 78c72838f3..d224f761e1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -61,7 +61,8 @@ must be the first non-whitespace on a line. For more information, see Info node `(elisp)Declaring Functions'." (declare (advertised-calling-convention (fn file &optional arglist fileonly) nil)) - ;; Does nothing - byte-compile-declare-function does the work. + ;; Does nothing - `byte-compile-macroexpand-declare-function' does + ;; the work. nil) commit 0d8e9588e1c9afea25ff1e947da9e5bda10cedf7 Author: YugaEgo <yet@ego.team> Date: Sun Dec 5 22:05:41 2021 +0100 * lisp/info.el (info-menu-star): Improve documentation * lisp/info.el (info-menu-star): Improve the doc string (bug#52315). diff --git a/lisp/info.el b/lisp/info.el index 94537c2417..559460e8d2 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -115,7 +115,9 @@ The Lisp code is executed when the node is selected.") (defface info-menu-star '((((class color)) :foreground "red1") (t :underline t)) - "Face for every third `*' in an Info menu.") + "Face used to emphasize `*' in an Info menu. +The face is assigned to the third, sixth, and ninth `*' for easier +orientation. See `Info-nth-menu-item'.") (defface info-xref '((t :inherit link)) commit e00623c5bd13b62d9a54935f744c2ad2afc718b7 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Dec 5 22:03:24 2021 +0100 Fix wording in eieio.texi (Generics) * doc/misc/eieio.texi (Generics): Fix wording in paragraph (bug#52317). diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 8a4b914687..c8d488d6ed 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -856,11 +856,12 @@ You can also create a generic method with @code{cl-defmethod} (@pxref{Methods}). When a method is created and there is no generic method in place with that name, then a new generic will be created, and the new method will use it. -@end defmac -In CLOS, a generic call also be used to provide an argument list and -dispatch precedence for all the arguments. In @eieio{}, dispatching -only occurs for the first argument, so the @var{arglist} is not used. +In CLOS, a generic method can also be used to provide an argument list +and dispatch precedence for all the arguments. In @eieio{}, +dispatching only occurs for the first argument, so the @var{arglist} +is not used. +@end defmac @node Methods @section Methods commit 6980a4fa450260b97830de52a69b039d9d020ff2 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Dec 5 21:20:03 2021 +0100 Fix regression introduced by previous context-menu-map change * lisp/mouse.el (context-menu-map): Make the context mode work with flyspell again (bug#52237). diff --git a/lisp/mouse.el b/lisp/mouse.el index b5ca80a446..af1eca12f4 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -330,7 +330,8 @@ the function `context-menu-filter-function'." ;; Remove duplicate separators as well as ones at the beginning or ;; end of the menu. (let ((l menu) saw-first-item) - (while (consp (cdr l)) + (while (and (consp l) + (consp (cdr l))) ;; If the next item is a separator, remove it if 1) we haven't ;; seen any other items yet, or 2) it's followed by either ;; another separator or the end of the list. commit 6faf72eab634fcb11b5a79128bf409e4a4ddaf0f Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Dec 5 21:15:00 2021 +0100 Revert "Clarify Creating Frames documentation" This reverts commit 5d7eb2979bc7eec01cff7e7908dbbd3edb38ea0c. The new documentation was incorrect. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 95360d4bdd..923ff19997 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -167,10 +167,11 @@ argument, the frame just created. @end defvar Note that any functions added to these hooks by your initial file are -usually not run for the initial frame. However, if the initial frame -is specified to use a separate minibuffer frame (@pxref{Minibuffers -and Frames}), the functions will be run for both, the minibuffer-less -and the minibuffer frame. +usually not run for the initial frame, since Emacs reads the initial +file only after creating that frame. However, if the initial frame is +specified to use a separate minibuffer frame (@pxref{Minibuffers and +Frames}), the functions will be run for both, the minibuffer-less and +the minibuffer frame. @defvar frame-inherited-parameters This variable specifies the list of frame parameters that a newly commit 8ef6eeeaea277436508e547c9f6c136fda283f12 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Dec 5 21:14:26 2021 +0100 Revert "Improve before-make-frame-hook and after-make-frame-functions docs" This reverts commit 7842a606b76dfabd1540da1c130728064e8f02ed. The new documentation was incorrect. diff --git a/lisp/frame.el b/lisp/frame.el index bc08649504..1319759e74 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -808,19 +808,12 @@ also select the new frame." new-frame)) (defvar before-make-frame-hook nil - "Functions to run before `make-frame' creates a new frame. -Note that these functions are usually not run for the initial -frame, except when the initial frame is created from an Emacs -daemon.") + "Functions to run before `make-frame' creates a new frame.") (defvar after-make-frame-functions nil "Functions to run after `make-frame' created a new frame. The functions are run with one argument, the newly created -frame. - -Note that these functions are usually not run for the initial -frame, except when the initial frame is created from an Emacs -daemon.") +frame.") (defvar after-setting-font-hook nil "Functions to run after a frame's font has been changed.") commit b961af66b9e8c4ccc8efee0401231e1a8ff42c77 Author: Lars Ingebrigtsen <larsi@gnus.org> Date: Sun Dec 5 20:53:47 2021 +0100 Fix fancy-about-screen point placement * lisp/startup.el (fancy-about-screen): Make point placement more resilient (bug#43636). diff --git a/lisp/startup.el b/lisp/startup.el index 8ea7a5b392..e5e6b07b4d 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1989,8 +1989,9 @@ splash screen in another window." (setq-local browse-url-browser-function 'eww-browse-url) (setq tab-width 22) (setq buffer-read-only t) + ;; Place point somewhere it doesn't cover a character. (goto-char (point-min)) - (forward-line 3)))) + (re-search-forward "\n$" nil nil 2)))) (defun fancy-splash-frame () "Return the frame to use for the fancy splash screen. commit 0bf10d508203b4afdaf5e95d03b906eefc7f69a2 Author: Glenn Morris <rgm@gnu.org> Date: Sun Dec 5 10:27:18 2021 -0800 * test/Makefile.in (check-declare): Add missing --batch. diff --git a/test/Makefile.in b/test/Makefile.in index d82f53157b..bb32ef672d 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -360,5 +360,5 @@ maintainer-clean: distclean bootstrap-clean .PHONY: check-declare check-declare: - $(emacs) -l check-declare \ + $(emacs) --batch -l check-declare \ --eval '(check-declare-directory "$(srcdir)")' commit 2d0e1e5595828f554d89ca660b5346aaeee7ff3a Author: Stefan Kangas <stefan@marxist.se> Date: Sun Dec 5 19:21:05 2021 +0100 Light copy-edits to recent additions to ERC manual * doc/misc/erc.texi (Introduction, Getting Started): Light copy-edits. diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 6631d8420f..7dbb5f0970 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -87,32 +87,31 @@ Advanced Usage @node Introduction @chapter Introduction +ERC is a powerful, modular, and extensible IRC client for Emacs. +It is distributed with Emacs since version 22.1. + IRC is short for Internet Relay Chat. When using IRC, you can -communicate with other users on the same IRC network. There are -several of these networks available---if you search for ``IRC -networks'' in your favorite search engine, you are likely to find -up-to-date lists of IRC networks catering to various interests and -topics. - -In order to use IRC, you need an IRC client such as ERC. Using the -client, you connect to an IRC server. Once you've done that, you will -have access to all available channels on that server's network. A -channel is basically a chat room, and what you type in a channel will -be shown to all other users in that channel, and you can be in several -channels at the same time---most clients will show each channel in its -own window. IRC channel names always begin with a @samp{#} character. -For example, the Emacs channel on Libera.Chat is @samp{#emacs}, and -the ERC channel is @samp{#erc}. Do not confuse them with the hashtags +communicate with other users on the same IRC network. There are many +different networks---if you search for ``IRC networks'' in your +favorite search engine, you will find up-to-date lists of IRC networks +catering to various interests and topics. + +To use IRC, you need an IRC client such as ERC. Using the client, you +connect to an IRC server. Once you've done that, you will have access +to all available channels on that server's network. A channel is +basically a chat room, and what you type in a channel will be shown to +all other users in that channel. You can be in several channels at +the same time---ERC will show each channel in its own buffer. + +IRC channel names always begin with a @samp{#} character. For +example, the Emacs channel on Libera.Chat is @samp{#emacs}, and the +ERC channel is @samp{#erc}. Do not confuse them with the hashtags used on many social media platforms. -It is also possible to send private messages to other IRC -users on the same network, regardless of whether or not they are in -the same channel as you. - -ERC is a powerful, modular, and extensible IRC client for Emacs. -It is distributed with Emacs since version 22.1. +You can also send private messages to other IRC users on the same +network, even if they are not in the same channels as you. -It comes with the following capabilities enabled by default. +ERC comes with the following capabilities enabled by default. @itemize @bullet @item Flood control @@ -137,10 +136,10 @@ It comes with the following capabilities enabled by default. The command @kbd{M-x erc} will start ERC and prompt for the server to connect to. If you're unsure of which server or network to connect -to, we suggest you start with ``irc.libera.chat''. There you will -find the @samp{#emacs} channels where you can chat with other Emacs -and users, and if you're having trouble with ERC, you can join the -@samp{#erc} channel and ask for help there. +to, we suggest starting with ``irc.libera.chat''. There you will find +the @samp{#emacs} channels where you can chat with other Emacs users, +and if you're having trouble with ERC, you can join the @samp{#erc} +channel and ask for help there. If you want to place ERC settings in their own file, you can place them in @file{~/.emacs.d/.ercrc.el}, creating it if necessary. commit fad4049a099486d115fc4d5ef2b7952867b7ca44 Author: Stefan Kangas <stefan@marxist.se> Date: Sun Dec 5 19:09:48 2021 +0100 Remove no-op calls to decode-char with 'ucs' arg * lisp/gnus/mm-util.el (mm-ucs-to-char): * lisp/language/hanja-util.el (hangul-to-hanja-char): * lisp/leim/quail/hangul.el (hangul3-input-method-internal) (hangul390-input-method-internal): * lisp/nxml/rng-cmpct.el (rng-c-process-escapes): * lisp/nxml/xsd-regexp.el (xsdre-compile-single-char) (xsdre-range-list-to-char-alternative): * lisp/xml.el (xml-parse-string, xml--entity-replacement-text) (xml-substitute-special): Remove calls to decode-char where first argument is 'ucs'; that is now a no-op. Discussed in Bug#52263. * lisp/nxml/xmltok.el (xmltok-unicode-to-char): Make into obsolete function alias for 'identity'. Update single caller. diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 92e04f9d2e..ddc228e490 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -31,7 +31,7 @@ (defun mm-ucs-to-char (codepoint) "Convert Unicode codepoint to character." - (or (decode-char 'ucs codepoint) ?#)) + (or codepoint ?#)) (defvar mm-coding-system-list nil) (defun mm-get-coding-system-list () diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el index 9e9213536c..fe6323d42b 100644 --- a/lisp/language/hanja-util.el +++ b/lisp/language/hanja-util.el @@ -6573,8 +6573,8 @@ The value is a hanja character that is selected interactively." (hanja-filter (lambda (x) (car x)) (mapcar (lambda (c) (if (listp c) - (cons (decode-char 'ucs (car c)) (cdr c)) - (list (decode-char 'ucs c)))) + (cons (car c) (cdr c)) + (list c))) (aref hanja-table char))))) (unwind-protect (when (aref hanja-conversions 2) diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el index c03e86b33c..d069b5b68e 100644 --- a/lisp/leim/quail/hangul.el +++ b/lisp/leim/quail/hangul.el @@ -429,7 +429,7 @@ When a Korean input method is off, convert the following hangul character." (hangul3-input-method-jong char)) (t (setq hangul-queue (make-vector 6 0)) - (insert (decode-char 'ucs char)) + (insert char) (move-overlay quail-overlay (point) (point)))))) (defun hangul3-input-method (key) @@ -476,7 +476,7 @@ When a Korean input method is off, convert the following hangul character." (hangul3-input-method-jong char)) (t (setq hangul-queue (make-vector 6 0)) - (insert (decode-char 'ucs char)) + (insert char) (move-overlay quail-overlay (point) (point)))))) (defun hangul390-input-method (key) diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el index dd3000773f..1476aa0e5a 100644 --- a/lisp/nxml/rng-cmpct.el +++ b/lisp/nxml/rng-cmpct.el @@ -369,7 +369,7 @@ OVERRIDE is either nil, require or t." (while (re-search-forward "\\\\x+{\\([[:xdigit:]]+\\)}" (point-max) t) - (let* ((ch (decode-char 'ucs (string-to-number (match-string 1) 16)))) + (let* ((ch (string-to-number (match-string 1) 16))) (if (and ch (> ch 0)) (let ((begin (match-beginning 0)) (end (match-end 0))) diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index 6159e00c51..ecad501a64 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -943,7 +943,6 @@ and VALUE-END, otherwise a STRING giving the value." (let ((n (string-to-number (buffer-substring-no-properties start end) base))) (cond ((and (integerp n) (xmltok-valid-char-p n)) - (setq n (xmltok-unicode-to-char n)) (and n (string n))) (t (xmltok-add-error "Invalid character code" start end) @@ -971,11 +970,6 @@ and VALUE-END, otherwise a STRING giving the value." (t (and (> n #xFFFF) (< n #x110000))))) -(defun xmltok-unicode-to-char (n) - "Return the character corresponding to Unicode scalar value N. -Return nil if unsupported in Emacs." - (decode-char 'ucs n)) - ;;; Prolog parsing (defvar xmltok-contains-doctype nil) @@ -1766,6 +1760,10 @@ and `xmltok-namespace-attributes'." xmltok-type)) (message "Scanned end of file"))) +;;; Obsolete + +(define-obsolete-function-alias 'xmltok-unicode-to-char #'identity "29.1") + (provide 'xmltok) ;;; xmltok.el ends here diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el index 3c29803ab9..d6eaf7cc4b 100644 --- a/lisp/nxml/xsd-regexp.el +++ b/lisp/nxml/xsd-regexp.el @@ -287,7 +287,7 @@ and whose tail is ACCUM." (defun xsdre-compile-single-char (ch) (if (memq ch '(?. ?* ?+ ?? ?\[ ?\] ?^ ?$ ?\\)) (string ?\\ ch) - (string (decode-char 'ucs ch)))) + (string ch))) (defun xsdre-char-class-to-range-list (cc) "Return a range-list for a symbolic char-class CC." @@ -404,10 +404,6 @@ consisting of a single char alternative delimited with []." (cons last chars) (cons last (cons ?- chars)))))) (setq range-list (cdr range-list))) - (setq chars - (mapcar (lambda (c) - (decode-char 'ucs c)) - chars)) (when caret (setq chars (cons ?^ chars))) (when hyphen diff --git a/lisp/xml.el b/lisp/xml.el index 0282e3741c..e2ba02e195 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -612,8 +612,8 @@ references." (if (setq ref (match-string 2)) (progn ; Numeric char reference (setq val (save-match-data - (decode-char 'ucs (string-to-number - ref (if (match-string 1) 16))))) + (string-to-number + ref (if (match-string 1) 16)))) (and (null val) xml-validating-parser (error "XML: (Validity) Invalid character reference `%s'" @@ -898,11 +898,11 @@ references and parameter-entity references." ref val) (cond ((setq ref (match-string 1 string)) ;; Decimal character reference - (setq val (decode-char 'ucs (string-to-number ref))) + (setq val (string-to-number ref)) (if val (push (string val) children))) ;; Hexadecimal character reference ((setq ref (match-string 2 string)) - (setq val (decode-char 'ucs (string-to-number ref 16))) + (setq val (string-to-number ref 16)) (if val (push (string val) children))) ;; Parameter entity reference ((setq ref (match-string 3 string)) @@ -962,7 +962,7 @@ STRING is assumed to occur in an XML attribute value." (if ref ;; [4.6] Character references are included as ;; character data. - (let ((val (decode-char 'ucs (string-to-number ref (if is-hex 16))))) + (let ((val (string-to-number ref (if is-hex 16)))) (push (cond (val (string val)) (xml-validating-parser (error "XML: (Validity) Undefined character `x%s'" ref)) commit 19307704bd6e73a6740f60459a6b5b58203b6a2f Author: Eric Abrahamsen <eric@ericabrahamsen.net> Date: Sat Dec 4 12:37:14 2021 -0800 Use gnus-error to report mail-source failures * lisp/gnus/mail-source.el (mail-source-fetch): Instead of querying the user on mail sources errors -- in effect asking "do you want to continue, or halt the process?" -- log the error with `gnus-error', severity 5. The query didn't provide any meaningful control; error reporting is all that's needed. (mail-source-ignore-errors): Obsolete this option; users can see the error or not by configuring `gnus-verbose'. * doc/misc/gnus.texi (Mail Source Customization): Remove mention of the above option from the manual. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index a18afec02e..6ffc057ba1 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -15447,10 +15447,6 @@ If non-@code{nil}, ask for confirmation before deleting old incoming files. This variable only applies when @code{mail-source-delete-incoming} is a positive number. -@item mail-source-ignore-errors -@vindex mail-source-ignore-errors -If non-@code{nil}, ignore errors when reading mail from a mail source. - @item mail-source-directory @vindex mail-source-directory Directory where incoming mail source files (if any) will be stored. The diff --git a/etc/NEWS b/etc/NEWS index df5e6ef790..a8b7dc56ba 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -693,6 +693,10 @@ Emacs buffers, like indentation and the like. The new ert function * Incompatible Lisp Changes in Emacs 29.1 +** User option 'mail-source-ignore-errors' is now obsolete +The whole mechanism for prompting users to continue in case of +mail-source errors has been removed, so this option is no longer +needed. ** Fonts --- diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index af0a198376..efdddea69f 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -224,12 +224,9 @@ Leave mails for this many days" :value 14))))) (const :format "" :value :plugged) (boolean :tag "Plugged")))))))) -(defcustom mail-source-ignore-errors nil - "Ignore errors when querying mail sources. -If nil, the user will be prompted when an error occurs. If non-nil, -the error will be ignored." - :version "22.1" - :type 'boolean) +(make-obsolete-variable 'mail-source-ignore-errors + "configure `gnus-verbose' instead" + "29.1") (defcustom mail-source-primary-source nil "Primary source for incoming mail. @@ -554,18 +551,16 @@ Return the number of files that were found." (condition-case err (funcall function source callback) (error - (if (and (not mail-source-ignore-errors) - (not - (yes-or-no-p - (format "Mail source %s error (%s). Continue? " + (gnus-error + 5 + (format "Mail source %s error (%s)" (if (memq ':password source) (let ((s (copy-sequence source))) (setcar (cdr (memq ':password s)) "********") s) source) - (cadr err))))) - (error "Cannot get new mail")) + (cadr err))) 0))))))))) (declare-function gnus-message "gnus-util" (level &rest args)) commit 25dc0d1de6e7770ff1109a434965fcff5202595d Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Dec 5 18:03:40 2021 +0200 ; Another protection from out-of-bounds access to it->stack[]. diff --git a/src/xdisp.c b/src/xdisp.c index 45b502590d..0ff6286af7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -30289,7 +30289,8 @@ produce_stretch_glyph (struct it *it) Compute the width of the characters having this `display' property. */ struct it it2; - Lisp_Object object = it->stack[it->sp - 1].string; + Lisp_Object object = + it->sp > 0 ? it->stack[it->sp - 1].string : it->string; unsigned char *p = (STRINGP (object) ? SDATA (object) + IT_STRING_BYTEPOS (*it) : BYTE_POS_ADDR (IT_BYTEPOS (*it))); commit 509dec902c45bc11cd8ff6664795b471d451742c Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Dec 5 17:34:05 2021 +0200 Fix out-of-bounds access in xdisp.c * src/xdisp.c (produce_stretch_glyph): Avoid indexing it->stack with a negative index. Reported by Po Lu <luangruo@yahoo.com>. diff --git a/src/xdisp.c b/src/xdisp.c index b2eeb1105b..45b502590d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -30391,7 +30391,8 @@ produce_stretch_glyph (struct it *it) if (width > 0 && height > 0 && it->glyph_row) { Lisp_Object o_object = it->object; - Lisp_Object object = it->stack[it->sp - 1].string; + Lisp_Object object = + it->sp > 0 ? it->stack[it->sp - 1].string : it->string; int n = width; if (!STRINGP (object)) commit 34f56561372d83b71dcaff1cdf5d9264ba38fa0e Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Dec 5 16:38:49 2021 +0200 Document the subtleties of the 'cursor' text property * doc/lispref/text.texi (Special Properties): Update the documentation of the 'cursor' property per bug#8627. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 41b3138a0d..f66cdfdbd1 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3647,14 +3647,14 @@ Consecutive characters with the same @code{field} property constitute a @kindex cursor @r{(text property)} Normally, the cursor is displayed at the beginning or the end of any overlay and text property strings present at the current buffer -position. You can place the cursor on any desired character of these -strings by giving that character a non-@code{nil} @code{cursor} text -property. In addition, if the value of the @code{cursor} property is -an integer, it specifies the number of buffer's character -positions, starting with the position where the overlay or the -@code{display} property begins, for which the cursor should be -displayed on that character. Specifically, if the value of the -@code{cursor} property of a character is the number @var{n}, the +position. You can instead tell Emacs to place the cursor on any +desired character of these strings by giving that character a +non-@code{nil} @code{cursor} text property. In addition, if the value +of the @code{cursor} property is an integer, it specifies the number +of buffer's character positions, starting with the position where the +overlay or the @code{display} property begins, for which the cursor +should be displayed on that character. Specifically, if the value of +the @code{cursor} property of a character is the number @var{n}, the cursor will be displayed on this character for any buffer position in the range @code{[@var{ovpos}..@var{ovpos}+@var{n})}, where @var{ovpos} is the overlay's starting position given by @code{overlay-start} @@ -3663,14 +3663,23 @@ text property begins in the buffer. In other words, the string character with the @code{cursor} property of any non-@code{nil} value is the character where to display the -cursor. The value of the property says for which buffer positions to -display the cursor there. If the value is an integer @var{n}, -the cursor is displayed there when point is anywhere between the -beginning of the overlay or @code{display} property and @var{n} -positions after that. If the value is anything else and -non-@code{nil}, the cursor is displayed there only when point is at -the beginning of the @code{display} property or at -@code{overlay-start}. +cursor when the overlay or display string make point not visible on +display. The value of the property says for which buffer positions to +display the cursor there. If the value is an integer @var{n}, the +cursor is displayed there when point is anywhere between the beginning +of the overlay or @code{display} property and @var{n} positions after +that. If the value is anything else and non-@code{nil}, the cursor is +displayed there only when point is at the buffer position that is the +beginning of the @code{display} property, or at @code{overlay-start} +if that position is not visible on display. Note that an integer +value of the @code{cursor} property could mean that the cursor is +displayed on that character even when point is visible on display. + +One subtlety of this property is that it doesn't work to put this +property on a newline character that is part of a display or overlay +string. That's because the newline doesn't have a graphic +representation on the screen for Emacs to find when it looks for a +character on display with that @code{cursor} property. @cindex cursor position for @code{display} properties and overlays When the buffer has many overlay strings (e.g., @pxref{Overlay commit 622550f7187f5ec9261a0d30b5ee6f440069a1e0 Author: Po Lu <luangruo@yahoo.com> Date: Sun Dec 5 21:34:54 2021 +0800 Interpolate large pixel scrolls * lisp/pixel-scroll.el (pixel-scroll-precision-large-scroll-height): New user option. (pixel-scroll-precision-interpolate): New function. (pixel-scroll-precision): Interpolate scrolls under some circumstances. diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 5d6836ca68..7722984424 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -133,6 +133,14 @@ This is only effective if supported by your mouse or touchpad." :type 'float :version "29.1") +(defcustom pixel-scroll-precision-large-scroll-height 70 + "Pixels that must be scrolled before an animation is performed. +Nil means to not interpolate such scrolls." + :group 'mouse + :type '(choice (const :tag "Do not interpolate large scrolls" nil) + number) + :version "29.1") + (defun pixel-scroll-in-rush-p () "Return non-nil if next scroll should be non-smooth. When scrolling request is delivered soon after the previous one, @@ -518,6 +526,28 @@ the height of the current window." (set-window-vscroll nil desired-vscroll t)) (set-window-vscroll nil (abs delta) t))))))) +(defun pixel-scroll-precision-interpolate (delta) + "Interpolate a scroll of DELTA pixels. +This results in the window being scrolled by DELTA pixels with an +animation." + (while-no-input + (let ((percentage 0) + (total-time 0.01) + (time-elapsed 0.0) + (between-scroll 0.001)) + (while (< percentage 1) + (sit-for between-scroll) + (setq time-elapsed (+ time-elapsed between-scroll) + percentage (/ time-elapsed total-time)) + (if (< delta 0) + (pixel-scroll-precision-scroll-down + (ceiling (abs (* delta + (/ between-scroll total-time))))) + (pixel-scroll-precision-scroll-up + (ceiling (* delta + (/ between-scroll total-time))))) + (redisplay t))))) + (defun pixel-scroll-precision-scroll-up (delta) "Scroll the current window up by DELTA pixels." (let ((max-height (- (window-text-height nil t) @@ -543,17 +573,32 @@ wheel." (if (> (abs delta) (window-text-height window t)) (mwheel-scroll event nil) (with-selected-window window - (condition-case nil + (if (and pixel-scroll-precision-large-scroll-height + (> (abs delta) + pixel-scroll-precision-large-scroll-height) + (let* ((kin-state (pixel-scroll-kinetic-state)) + (ring (aref kin-state 0)) + (time (aref kin-state 1))) + (or (null time) + (> (- (float-time) time) 1.0) + (and (consp ring) + (ring-empty-p ring))))) (progn - (if (< delta 0) - (pixel-scroll-precision-scroll-down (- delta)) - (pixel-scroll-precision-scroll-up delta)) - (pixel-scroll-accumulate-velocity delta)) - ;; Do not ding at buffer limits. Show a message instead. - (beginning-of-buffer - (message (error-message-string '(beginning-of-buffer)))) - (end-of-buffer - (message (error-message-string '(end-of-buffer))))))))) + (let ((kin-state (pixel-scroll-kinetic-state))) + (aset kin-state 0 (make-ring 10)) + (aset kin-state 1 nil)) + (pixel-scroll-precision-interpolate delta)) + (condition-case nil + (progn + (if (< delta 0) + (pixel-scroll-precision-scroll-down (- delta)) + (pixel-scroll-precision-scroll-up delta)) + (pixel-scroll-accumulate-velocity delta)) + ;; Do not ding at buffer limits. Show a message instead. + (beginning-of-buffer + (message (error-message-string '(beginning-of-buffer)))) + (end-of-buffer + (message (error-message-string '(end-of-buffer)))))))))) (mwheel-scroll event nil)))) (defun pixel-scroll-kinetic-state () commit d16db92cc790d0c3277e20a83030df6c4b5764e9 Author: Stefan Kangas <stefan@marxist.se> Date: Sun Dec 5 12:54:53 2021 +0100 Silence byte-compiler in generator-tests.el * test/lisp/emacs-lisp/generator-tests.el (cps-let*-shadow-empty) (cps-let-shadow-empty, cps-let*-parallel): Silence byte-compiler. diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el index 492c4e4085..1d2aa7ab37 100644 --- a/test/lisp/emacs-lisp/generator-tests.el +++ b/test/lisp/emacs-lisp/generator-tests.el @@ -85,9 +85,9 @@ identical output." (cps-testcase cps-or-empty (or)) (cps-testcase cps-let* (let* ((i 10)) i)) -(cps-testcase cps-let*-shadow-empty (let* ((i 10)) (let (i) i))) +(cps-testcase cps-let*-shadow-empty (let* ((i 10)) i (let ((i nil)) i))) (cps-testcase cps-let (let ((i 10)) i)) -(cps-testcase cps-let-shadow-empty (let ((i 10)) (let (i) i))) +(cps-testcase cps-let-shadow-empty (let ((i 10)) i (let ((i nil)) i))) (cps-testcase cps-let-novars (let nil 42)) (cps-testcase cps-let*-novars (let* nil 42)) @@ -95,7 +95,7 @@ identical output." (let ((a 5) (b 6)) (let ((a b) (b a)) (list a b)))) (cps-testcase cps-let*-parallel - (let* ((a 5) (b 6)) (let* ((a b) (b a)) (list a b)))) + (let* ((a 5) (b 6)) a (let* ((a b) (b a)) (list a b)))) (cps-testcase cps-while-dynamic (setq *cps-test-i* 0) commit 722a8ebb71227a18feeff1121d5b30122a7856e5 Author: Stefan Kangas <stefan@marxist.se> Date: Sun Dec 5 12:49:52 2021 +0100 Silence warnings about testing obsolete functions and macros * test/lisp/emacs-lisp/cl-generic-tests.el: * test/lisp/emacs-lisp/edebug-tests.el: * test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el: * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el: Silence byte-compiler warnings about testing obsolete functions and macros. diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index dd7511e9af..9c285a9fac 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -200,9 +200,14 @@ (fmakunbound 'cl--generic-1) (cl-defgeneric cl--generic-1 (x y)) (cl-defmethod cl--generic-1 ((x t) y) - (list x y (cl-next-method-p))) + (list x y + (with-suppressed-warnings ((obsolete cl-next-method-p)) + (cl-next-method-p)))) (cl-defmethod cl--generic-1 ((_x (eql 4)) _y) - (cl-list* "quatre" (cl-next-method-p) (cl-call-next-method))) + (cl-list* "quatre" + (with-suppressed-warnings ((obsolete cl-next-method-p)) + (cl-next-method-p)) + (cl-call-next-method))) (should (equal (cl--generic-1 4 5) '("quatre" t 4 5 nil)))) (ert-deftest cl-generic-test-12-context () diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 9285b2c945..210bf24880 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -860,7 +860,8 @@ test and possibly others should be updated." (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)) (insert "`1")) - (edebug-eval-defun nil) + (with-suppressed-warnings ((obsolete edebug-eval-defun)) + (edebug-eval-defun nil)) ;; `eval-defun' outputs its message to the echo area in a rather ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed ;; there in separate pieces (via `print' rather than via `message'). @@ -870,7 +871,8 @@ test and possibly others should be updated." (setq edebug-initial-mode 'go) ;; In Bug#23651 Edebug would hang reading `1. - (edebug-eval-defun t))) + (with-suppressed-warnings ((obsolete edebug-eval-defun)) + (edebug-eval-defun t)))) (ert-deftest edebug-tests-trivial-comma () "Edebug can read a trivial comma expression (Bug#23651)." @@ -879,7 +881,8 @@ test and possibly others should be updated." (delete-region (point-min) (point-max)) (insert ",1") (read-only-mode) - (should-error (edebug-eval-defun t)))) + (with-suppressed-warnings ((obsolete edebug-eval-defun)) + (should-error (edebug-eval-defun t))))) (ert-deftest edebug-tests-circular-read-syntax () "Edebug can instrument code using circular read object syntax (Bug#23660)." diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el index d1da066dc4..ee52d831d6 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el @@ -85,37 +85,40 @@ (defclass eitest-B-base2 () ()) (defclass eitest-B (eitest-B-base1 eitest-B-base2) ()) -(defmethod eitest-F :BEFORE ((_p eitest-B-base1)) - (eieio-test-method-store :BEFORE 'eitest-B-base1)) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric) + (obsolete call-next-method) + (obsolete next-method-p)) + (defmethod eitest-F :BEFORE ((_p eitest-B-base1)) + (eieio-test-method-store :BEFORE 'eitest-B-base1)) -(defmethod eitest-F :BEFORE ((_p eitest-B-base2)) - (eieio-test-method-store :BEFORE 'eitest-B-base2)) + (defmethod eitest-F :BEFORE ((_p eitest-B-base2)) + (eieio-test-method-store :BEFORE 'eitest-B-base2)) -(defmethod eitest-F :BEFORE ((_p eitest-B)) - (eieio-test-method-store :BEFORE 'eitest-B)) + (defmethod eitest-F :BEFORE ((_p eitest-B)) + (eieio-test-method-store :BEFORE 'eitest-B)) -(defmethod eitest-F ((_p eitest-B)) - (eieio-test-method-store :PRIMARY 'eitest-B) - (call-next-method)) - -(defmethod eitest-F ((_p eitest-B-base1)) - (eieio-test-method-store :PRIMARY 'eitest-B-base1) - (call-next-method)) + (defmethod eitest-F ((_p eitest-B)) + (eieio-test-method-store :PRIMARY 'eitest-B) + (call-next-method)) -(defmethod eitest-F ((_p eitest-B-base2)) - (eieio-test-method-store :PRIMARY 'eitest-B-base2) - (when (next-method-p) + (defmethod eitest-F ((_p eitest-B-base1)) + (eieio-test-method-store :PRIMARY 'eitest-B-base1) (call-next-method)) - ) -(defmethod eitest-F :AFTER ((_p eitest-B-base1)) - (eieio-test-method-store :AFTER 'eitest-B-base1)) + (defmethod eitest-F ((_p eitest-B-base2)) + (eieio-test-method-store :PRIMARY 'eitest-B-base2) + (when (next-method-p) + (call-next-method))) -(defmethod eitest-F :AFTER ((_p eitest-B-base2)) - (eieio-test-method-store :AFTER 'eitest-B-base2)) + (defmethod eitest-F :AFTER ((_p eitest-B-base1)) + (eieio-test-method-store :AFTER 'eitest-B-base1)) -(defmethod eitest-F :AFTER ((_p eitest-B)) - (eieio-test-method-store :AFTER 'eitest-B)) + (defmethod eitest-F :AFTER ((_p eitest-B-base2)) + (eieio-test-method-store :AFTER 'eitest-B-base2)) + + (defmethod eitest-F :AFTER ((_p eitest-B)) + (eieio-test-method-store :AFTER 'eitest-B))) (ert-deftest eieio-test-method-order-list-3 () (let ((eieio-test-method-order-list nil) @@ -138,9 +141,11 @@ ;;; Test static invocation ;; -(defmethod eitest-H :STATIC ((_class eitest-A)) - "No need to do work in here." - 'moose) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod eitest-H :STATIC ((_class eitest-A)) + "No need to do work in here." + 'moose)) (ert-deftest eieio-test-method-order-list-4 () ;; Both of these situations should succeed. @@ -149,17 +154,19 @@ ;;; Return value from :PRIMARY ;; -(defmethod eitest-I :BEFORE ((_a eitest-A)) - (eieio-test-method-store :BEFORE 'eitest-A) - ":before") +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod eitest-I :BEFORE ((_a eitest-A)) + (eieio-test-method-store :BEFORE 'eitest-A) + ":before") -(defmethod eitest-I :PRIMARY ((_a eitest-A)) - (eieio-test-method-store :PRIMARY 'eitest-A) - ":primary") + (defmethod eitest-I :PRIMARY ((_a eitest-A)) + (eieio-test-method-store :PRIMARY 'eitest-A) + ":primary") -(defmethod eitest-I :AFTER ((_a eitest-A)) - (eieio-test-method-store :AFTER 'eitest-A) - ":after") + (defmethod eitest-I :AFTER ((_a eitest-A)) + (eieio-test-method-store :AFTER 'eitest-A) + ":after")) (ert-deftest eieio-test-method-order-list-5 () (let ((eieio-test-method-order-list nil) @@ -175,16 +182,18 @@ (defclass C-base2 () ()) (defclass C (C-base1 C-base2) ()) -;; Just use the obsolete name once, to make sure it also works. -(defmethod constructor :STATIC ((_p C-base1) &rest _args) - (eieio-test-method-store :STATIC 'C-base1) - (if (next-method-p) (call-next-method)) - ) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric) + (obsolete next-method-p) + (obsolete call-next-method)) + ;; Just use the obsolete name once, to make sure it also works. + (defmethod constructor :STATIC ((_p C-base1) &rest _args) + (eieio-test-method-store :STATIC 'C-base1) + (if (next-method-p) (call-next-method))) -(defmethod make-instance :STATIC ((_p C-base2) &rest _args) - (eieio-test-method-store :STATIC 'C-base2) - (if (next-method-p) (call-next-method)) - ) + (defmethod make-instance :STATIC ((_p C-base2) &rest _args) + (eieio-test-method-store :STATIC 'C-base2) + (if (next-method-p) (call-next-method)))) (cl-defmethod make-instance ((_p (subclass C)) &rest _args) (eieio-test-method-store :STATIC 'C) @@ -215,29 +224,32 @@ (defclass D-base2 (D-base0) () :method-invocation-order :depth-first) (defclass D (D-base1 D-base2) () :method-invocation-order :depth-first) -(defmethod eitest-F ((_p D)) - "D" - (eieio-test-method-store :PRIMARY 'D) - (call-next-method)) - -(defmethod eitest-F ((_p D-base0)) - "D-base0" - (eieio-test-method-store :PRIMARY 'D-base0) - ;; This should have no next - ;; (when (next-method-p) (call-next-method)) - ) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric) + (obsolete call-next-method) + (obsolete next-method-p)) + (defmethod eitest-F ((_p D)) + "D" + (eieio-test-method-store :PRIMARY 'D) + (call-next-method)) -(defmethod eitest-F ((_p D-base1)) - "D-base1" - (eieio-test-method-store :PRIMARY 'D-base1) - (call-next-method)) + (defmethod eitest-F ((_p D-base0)) + "D-base0" + (eieio-test-method-store :PRIMARY 'D-base0) + ;; This should have no next + ;; (when (next-method-p) (call-next-method)) + ) -(defmethod eitest-F ((_p D-base2)) - "D-base2" - (eieio-test-method-store :PRIMARY 'D-base2) - (when (next-method-p) + (defmethod eitest-F ((_p D-base1)) + "D-base1" + (eieio-test-method-store :PRIMARY 'D-base1) (call-next-method)) - ) + + (defmethod eitest-F ((_p D-base2)) + "D-base2" + (eieio-test-method-store :PRIMARY 'D-base2) + (when (next-method-p) + (call-next-method)))) (ert-deftest eieio-test-method-order-list-7 () (let ((eieio-test-method-order-list nil) @@ -258,25 +270,27 @@ (defclass E-base2 (E-base0) () :method-invocation-order :breadth-first) (defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first) -(defmethod eitest-F ((_p E)) - (eieio-test-method-store :PRIMARY 'E) - (call-next-method)) - -(defmethod eitest-F ((_p E-base0)) - (eieio-test-method-store :PRIMARY 'E-base0) - ;; This should have no next - ;; (when (next-method-p) (call-next-method)) - ) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete next-method-p) + (obsolete call-next-method)) + (defmethod eitest-F ((_p E)) + (eieio-test-method-store :PRIMARY 'E) + (call-next-method)) -(defmethod eitest-F ((_p E-base1)) - (eieio-test-method-store :PRIMARY 'E-base1) - (call-next-method)) + (defmethod eitest-F ((_p E-base0)) + (eieio-test-method-store :PRIMARY 'E-base0) + ;; This should have no next + ;; (when (next-method-p) (call-next-method)) + ) -(defmethod eitest-F ((_p E-base2)) - (eieio-test-method-store :PRIMARY 'E-base2) - (when (next-method-p) + (defmethod eitest-F ((_p E-base1)) + (eieio-test-method-store :PRIMARY 'E-base1) (call-next-method)) - ) + + (defmethod eitest-F ((_p E-base2)) + (eieio-test-method-store :PRIMARY 'E-base2) + (when (next-method-p) + (call-next-method)))) (ert-deftest eieio-test-method-order-list-8 () (let ((eieio-test-method-order-list nil) @@ -295,24 +309,31 @@ (defclass eitest-Ja () ()) -(defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots) - ;(message "+Ja") - ;; FIXME: Using next-method-p in an after-method is invalid! - (when (next-method-p) - (call-next-method)) - ;(message "-Ja") - ) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric) + (obsolete next-method-p) + (obsolete call-next-method)) + (defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots) + ;;(message "+Ja") + ;; FIXME: Using next-method-p in an after-method is invalid! + (when (next-method-p) + (call-next-method)) + ;;(message "-Ja") + )) (defclass eitest-Jb () ()) -(defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots) - ;(message "+Jb") - ;; FIXME: Using next-method-p in an after-method is invalid! - (when (next-method-p) - (call-next-method)) - ;(message "-Jb") - ) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete next-method-p) + (obsolete call-next-method)) + (defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots) + ;;(message "+Jb") + ;; FIXME: Using next-method-p in an after-method is invalid! + (when (next-method-p) + (call-next-method)) + ;;(message "-Jb") + )) (defclass eitest-Jc (eitest-Jb) ()) @@ -320,12 +341,16 @@ (defclass eitest-Jd (eitest-Jc eitest-Ja) ()) -(defmethod initialize-instance ((_this eitest-Jd) &rest _slots) - ;(message "+Jd") - (when (next-method-p) - (call-next-method)) - ;(message "-Jd") - ) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric) + (obsolete next-method-p) + (obsolete call-next-method)) + (defmethod initialize-instance ((_this eitest-Jd) &rest _slots) + ;;(message "+Jd") + (when (next-method-p) + (call-next-method)) + ;;(message "-Jd") + )) (ert-deftest eieio-test-method-order-list-9 () (should (eitest-Jd))) @@ -345,32 +370,36 @@ (defclass CNM-2 (CNM-1-1 CNM-1-2) ()) -(defmethod CNM-M ((this CNM-0) args) - (push (cons 'CNM-0 (copy-sequence args)) - eieio-test-call-next-method-arguments) - (when (next-method-p) - (call-next-method - this (cons 'CNM-0 args)))) - -(defmethod CNM-M ((this CNM-1-1) args) - (push (cons 'CNM-1-1 (copy-sequence args)) - eieio-test-call-next-method-arguments) - (when (next-method-p) - (call-next-method - this (cons 'CNM-1-1 args)))) - -(defmethod CNM-M ((_this CNM-1-2) args) - (push (cons 'CNM-1-2 (copy-sequence args)) - eieio-test-call-next-method-arguments) - (when (next-method-p) - (call-next-method))) - -(defmethod CNM-M ((this CNM-2) args) - (push (cons 'CNM-2 (copy-sequence args)) - eieio-test-call-next-method-arguments) - (when (next-method-p) - (call-next-method - this (cons 'CNM-2 args)))) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric) + (obsolete next-method-p) + (obsolete call-next-method)) + (defmethod CNM-M ((this CNM-0) args) + (push (cons 'CNM-0 (copy-sequence args)) + eieio-test-call-next-method-arguments) + (when (next-method-p) + (call-next-method + this (cons 'CNM-0 args)))) + + (defmethod CNM-M ((this CNM-1-1) args) + (push (cons 'CNM-1-1 (copy-sequence args)) + eieio-test-call-next-method-arguments) + (when (next-method-p) + (call-next-method + this (cons 'CNM-1-1 args)))) + + (defmethod CNM-M ((_this CNM-1-2) args) + (push (cons 'CNM-1-2 (copy-sequence args)) + eieio-test-call-next-method-arguments) + (when (next-method-p) + (call-next-method))) + + (defmethod CNM-M ((this CNM-2) args) + (push (cons 'CNM-2 (copy-sequence args)) + eieio-test-call-next-method-arguments) + (when (next-method-p) + (call-next-method + this (cons 'CNM-2 args))))) (ert-deftest eieio-test-method-order-list-10 () (let ((eieio-test-call-next-method-arguments nil)) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 6f6a1f4f19..599d7900c3 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -160,30 +160,33 @@ ;; error (should-error (abstract-class))) -(defgeneric generic1 () "First generic function.") +(with-suppressed-warnings ((obsolete defgeneric)) + (defgeneric generic1 () "First generic function.")) (ert-deftest eieio-test-03-generics () - (defun anormalfunction () "A plain function for error testing." nil) - (should-error - (progn - (defgeneric anormalfunction () - "Attempt to turn it into a generic."))) - - ;; Check that generic-p works - (should (generic-p 'generic1)) - - (defmethod generic1 ((_c class-a)) - "Method on generic1." - 'monkey) - - (defmethod generic1 (not-an-object) - "Method generic1 that can take a non-object." - not-an-object) - - (let ((ans-obj (generic1 (class-a))) - (ans-num (generic1 666))) - (should (eq ans-obj 'monkey)) - (should (eq ans-num 666)))) + (with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defun anormalfunction () "A plain function for error testing." nil) + (should-error + (progn + (defgeneric anormalfunction () + "Attempt to turn it into a generic."))) + + ;; Check that generic-p works + (should (generic-p 'generic1)) + + (defmethod generic1 ((_c class-a)) + "Method on generic1." + 'monkey) + + (defmethod generic1 (not-an-object) + "Method generic1 that can take a non-object." + not-an-object) + + (let ((ans-obj (generic1 (class-a))) + (ans-num (generic1 666))) + (should (eq ans-obj 'monkey)) + (should (eq ans-num 666))))) (defclass static-method-class () ((some-slot :initform nil @@ -191,11 +194,13 @@ :documentation "A slot.")) :documentation "A class used for testing static methods.") -(defmethod static-method-class-method :STATIC ((c static-method-class) value) - "Test static methods. +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod static-method-class-method :STATIC ((c static-method-class) value) + "Test static methods. Argument C is the class bound to this static method." - (if (eieio-object-p c) (setq c (eieio-object-class c))) - (oset-default c some-slot value)) + (if (eieio-object-p c) (setq c (eieio-object-class c))) + (oset-default c some-slot value))) (ert-deftest eieio-test-04-static-method () ;; Call static method on a class and see if it worked @@ -209,11 +214,13 @@ Argument C is the class bound to this static method." () "A second class after the previous for static methods.") - (defmethod static-method-class-method :STATIC ((c static-method-class-2) value) - "Test static methods. + (with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod static-method-class-method :STATIC ((c static-method-class-2) value) + "Test static methods. Argument C is the class bound to this static method." - (if (eieio-object-p c) (setq c (eieio-object-class c))) - (oset-default c some-slot (intern (concat "moose-" (symbol-name value))))) + (if (eieio-object-p c) (setq c (eieio-object-class c))) + (oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))) (static-method-class-method 'static-method-class-2 'class) (should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class)) @@ -240,64 +247,71 @@ Argument C is the class bound to this static method." (should (make-instance 'class-a :water 'cho)) (should (make-instance 'class-b))) -(defmethod class-cn ((_a class-a)) - "Try calling `call-next-method' when there isn't one. +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod class-cn ((_a class-a)) + "Try calling `call-next-method' when there isn't one. Argument A is object of type symbol `class-a'." - (call-next-method)) + (with-suppressed-warnings ((obsolete call-next-method)) + (call-next-method))) -(defmethod no-next-method ((_a class-a) &rest _args) - "Override signal throwing for variable `class-a'. + (defmethod no-next-method ((_a class-a) &rest _args) + "Override signal throwing for variable `class-a'. Argument A is the object of class variable `class-a'." - 'moose) + 'moose)) (ert-deftest eieio-test-08-call-next-method () ;; Play with call-next-method (should (eq (class-cn eitest-ab) 'moose))) -(defmethod no-applicable-method ((_b class-b) _method &rest _args) - "No need. +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod no-applicable-method ((_b class-b) _method &rest _args) + "No need. Argument B is for booger. METHOD is the method that was attempting to be called." - 'moose) + 'moose)) (ert-deftest eieio-test-09-no-applicable-method () ;; Non-existing methods. (should (eq (class-cn eitest-b) 'moose))) -(defmethod class-fun ((_a class-a)) - "Fun with class A." - 'moose) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod class-fun ((_a class-a)) + "Fun with class A." + 'moose) -(defmethod class-fun ((_b class-b)) - "Fun with class B." - (error "Class B fun should not be called") - ) + (defmethod class-fun ((_b class-b)) + "Fun with class B." + (error "Class B fun should not be called")) -(defmethod class-fun-foo ((_b class-b)) - "Foo Fun with class B." - 'moose) + (defmethod class-fun-foo ((_b class-b)) + "Foo Fun with class B." + 'moose) -(defmethod class-fun2 ((_a class-a)) - "More fun with class A." - 'moose) + (defmethod class-fun2 ((_a class-a)) + "More fun with class A." + 'moose) -(defmethod class-fun2 ((_b class-b)) - "More fun with class B." - (error "Class B fun2 should not be called") - ) + (defmethod class-fun2 ((_b class-b)) + "More fun with class B." + (error "Class B fun2 should not be called")) -(defmethod class-fun2 ((_ab class-ab)) - "More fun with class AB." - (call-next-method)) + (defmethod class-fun2 ((_ab class-ab)) + "More fun with class AB." + (with-suppressed-warnings ((obsolete call-next-method)) + (call-next-method))) -;; How about if B is the only slot? -(defmethod class-fun3 ((_b class-b)) - "Even More fun with class B." - 'moose) + ;; How about if B is the only slot? + (defmethod class-fun3 ((_b class-b)) + "Even More fun with class B." + 'moose) -(defmethod class-fun3 ((_ab class-ab)) - "Even More fun with class AB." - (call-next-method)) + (defmethod class-fun3 ((_ab class-ab)) + "Even More fun with class AB." + (with-suppressed-warnings ((obsolete call-next-method)) + (call-next-method)))) (ert-deftest eieio-test-10-multiple-inheritance () ;; play with methods and mi @@ -314,20 +328,22 @@ METHOD is the method that was attempting to be called." (defvar class-fun-value-seq '()) -(defmethod class-fun-value :BEFORE ((_a class-a)) - "Return `before', and push `before' in `class-fun-value-seq'." - (push 'before class-fun-value-seq) - 'before) - -(defmethod class-fun-value :PRIMARY ((_a class-a)) - "Return `primary', and push `primary' in `class-fun-value-seq'." - (push 'primary class-fun-value-seq) - 'primary) - -(defmethod class-fun-value :AFTER ((_a class-a)) - "Return `after', and push `after' in `class-fun-value-seq'." - (push 'after class-fun-value-seq) - 'after) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod class-fun-value :BEFORE ((_a class-a)) + "Return `before', and push `before' in `class-fun-value-seq'." + (push 'before class-fun-value-seq) + 'before) + + (defmethod class-fun-value :PRIMARY ((_a class-a)) + "Return `primary', and push `primary' in `class-fun-value-seq'." + (push 'primary class-fun-value-seq) + 'primary) + + (defmethod class-fun-value :AFTER ((_a class-a)) + "Return `after', and push `after' in `class-fun-value-seq'." + (push 'after class-fun-value-seq) + 'after)) (ert-deftest eieio-test-12-generic-function-call () ;; Test value of a generic function call @@ -343,20 +359,23 @@ METHOD is the method that was attempting to be called." ;; (ert-deftest eieio-test-13-init-methods () - (defmethod initialize-instance ((a class-a) &rest _slots) - "Initialize the slots of class-a." - (call-next-method) - (if (/= (oref a test-tag) 1) - (error "shared-initialize test failed.")) - (oset a test-tag 2)) - - (defmethod shared-initialize ((a class-a) &rest _slots) - "Shared initialize method for class-a." - (call-next-method) - (oset a test-tag 1)) - - (let ((ca (class-a))) - (should (= (oref ca test-tag) 2)))) + (with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric) + (obsolete call-next-method)) + (defmethod initialize-instance ((a class-a) &rest _slots) + "Initialize the slots of class-a." + (call-next-method) + (if (/= (oref a test-tag) 1) + (error "shared-initialize test failed.")) + (oset a test-tag 2)) + + (defmethod shared-initialize ((a class-a) &rest _slots) + "Shared initialize method for class-a." + (call-next-method) + (oset a test-tag 1)) + + (let ((ca (class-a))) + (should (= (oref ca test-tag) 2))))) ;;; Perform slot testing @@ -368,10 +387,11 @@ METHOD is the method that was attempting to be called." (should (oref eitest-ab amphibian))) (ert-deftest eieio-test-15-slot-missing () - - (defmethod slot-missing ((_ab class-ab) &rest _foo) - "If a slot in AB is unbound, return something cool. FOO." - 'moose) + (with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod slot-missing ((_ab class-ab) &rest _foo) + "If a slot in AB is unbound, return something cool. FOO." + 'moose)) (should (eq (oref eitest-ab ooga-booga) 'moose)) (should-error (oref eitest-a ooga-booga) :type 'invalid-slot-name)) @@ -391,17 +411,20 @@ METHOD is the method that was attempting to be called." (defclass virtual-slot-class () ((base-value :initarg :base-value)) "Class has real slot :base-value and simulated slot :derived-value.") -(defmethod slot-missing ((vsc virtual-slot-class) - slot-name operation &optional new-value) - "Simulate virtual slot derived-value." - (cond - ((or (eq slot-name :derived-value) - (eq slot-name 'derived-value)) - (with-slots (base-value) vsc - (if (eq operation 'oref) - (+ base-value 1) - (setq base-value (- new-value 1))))) - (t (call-next-method)))) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod slot-missing ((vsc virtual-slot-class) + slot-name operation &optional new-value) + "Simulate virtual slot derived-value." + (cond + ((or (eq slot-name :derived-value) + (eq slot-name 'derived-value)) + (with-slots (base-value) vsc + (if (eq operation 'oref) + (+ base-value 1) + (setq base-value (- new-value 1))))) + (t (with-suppressed-warnings ((obsolete call-next-method)) + (call-next-method)))))) (ert-deftest eieio-test-17-virtual-slot () (setq eitest-vsca (virtual-slot-class :base-value 1)) @@ -424,35 +447,37 @@ METHOD is the method that was attempting to be called." (should (= (oref eitest-vscb :derived-value) 5))) (ert-deftest eieio-test-18-slot-unbound () - - (defmethod slot-unbound ((_a class-a) &rest _foo) - "If a slot in A is unbound, ignore FOO." - 'moose) - - (should (eq (oref eitest-a water) 'moose)) - - ;; Check if oset of unbound works - (oset eitest-a water 'moose) - (should (eq (oref eitest-a water) 'moose)) - - ;; oref/oref-default comparison - (should-not (eq (oref eitest-a water) (oref-default eitest-a water))) - - ;; oset-default -> oref/oref-default comparison - (oset-default (eieio-object-class eitest-a) water 'moose) - (should (eq (oref eitest-a water) (oref-default eitest-a water))) - - ;; After setting 'water to 'moose, make sure a new object has - ;; the right stuff. - (oset-default (eieio-object-class eitest-a) water 'penguin) - (should (eq (oref (class-a) water) 'penguin)) - - ;; Revert the above - (defmethod slot-unbound ((_a class-a) &rest _foo) - "If a slot in A is unbound, ignore FOO." - ;; Disable the old slot-unbound so we can run this test - ;; more than once - (call-next-method))) + (with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod slot-unbound ((_a class-a) &rest _foo) + "If a slot in A is unbound, ignore FOO." + 'moose) + + (should (eq (oref eitest-a water) 'moose)) + + ;; Check if oset of unbound works + (oset eitest-a water 'moose) + (should (eq (oref eitest-a water) 'moose)) + + ;; oref/oref-default comparison + (should-not (eq (oref eitest-a water) (oref-default eitest-a water))) + + ;; oset-default -> oref/oref-default comparison + (oset-default (eieio-object-class eitest-a) water 'moose) + (should (eq (oref eitest-a water) (oref-default eitest-a water))) + + ;; After setting 'water to 'moose, make sure a new object has + ;; the right stuff. + (oset-default (eieio-object-class eitest-a) water 'penguin) + (should (eq (oref (class-a) water) 'penguin)) + + ;; Revert the above + (defmethod slot-unbound ((_a class-a) &rest _foo) + "If a slot in A is unbound, ignore FOO." + ;; Disable the old slot-unbound so we can run this test + ;; more than once + (with-suppressed-warnings ((obsolete call-next-method)) + (call-next-method))))) (ert-deftest eieio-test-19-slot-type-checking () ;; Slot type checking @@ -617,12 +642,14 @@ METHOD is the method that was attempting to be called." () "Protection testing baseclass.") -(defmethod prot0-slot-2 ((s2 prot-0)) - "Try to access slot-2 from this class which doesn't have it. +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod prot0-slot-2 ((s2 prot-0)) + "Try to access slot-2 from this class which doesn't have it. The object S2 passed in will be of class prot-1, which does have the slot. This could be allowed, and currently is in EIEIO. Needed by the eieio persistent base class." - (oref s2 slot-2)) + (oref s2 slot-2))) (defclass prot-1 (prot-0) ((slot-1 :initarg :slot-1 @@ -640,26 +667,28 @@ Needed by the eieio persistent base class." nil "A class for testing the :protection option.") -(defmethod prot1-slot-2 ((s2 prot-1)) - "Try to access slot-2 in S2." - (oref s2 slot-2)) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod prot1-slot-2 ((s2 prot-1)) + "Try to access slot-2 in S2." + (oref s2 slot-2)) -(defmethod prot1-slot-2 ((s2 prot-2)) - "Try to access slot-2 in S2." - (oref s2 slot-2)) + (defmethod prot1-slot-2 ((s2 prot-2)) + "Try to access slot-2 in S2." + (oref s2 slot-2)) -(defmethod prot1-slot-3-only ((s2 prot-1)) - "Try to access slot-3 in S2. + (defmethod prot1-slot-3-only ((s2 prot-1)) + "Try to access slot-3 in S2. Do not override for `prot-2'." - (oref s2 slot-3)) + (oref s2 slot-3)) -(defmethod prot1-slot-3 ((s2 prot-1)) - "Try to access slot-3 in S2." - (oref s2 slot-3)) + (defmethod prot1-slot-3 ((s2 prot-1)) + "Try to access slot-3 in S2." + (oref s2 slot-3)) -(defmethod prot1-slot-3 ((s2 prot-2)) - "Try to access slot-3 in S2." - (oref s2 slot-3)) + (defmethod prot1-slot-3 ((s2 prot-2)) + "Try to access slot-3 in S2." + (oref s2 slot-3))) (defvar eitest-p1 nil) (defvar eitest-p2 nil) @@ -914,8 +943,10 @@ Subclasses to override slot attributes.") (defclass eieio--testing () ()) -(defmethod constructor :static ((_x eieio--testing) newname &rest _args) - (list newname 2)) +(with-suppressed-warnings ((obsolete defmethod) + (obsolete defgeneric)) + (defmethod constructor :static ((_x eieio--testing) newname &rest _args) + (list newname 2))) (ert-deftest eieio-test-37-obsolete-name-in-constructor () ;; FIXME repeated intermittent failures on hydra and elsewhere (bug#24503). commit 9167fbd323c5f8ca1262372be0e213f284cadc67 Author: Stefan Kangas <stefan@marxist.se> Date: Sun Dec 5 12:08:27 2021 +0100 Remove hacks for broken `with-suppressed-warnings' * test/lisp/obsolete/cl-tests.el (labels-function-quoting): * test/lisp/tar-mode-tests.el (tar-mode-test-tar-grind-file-mode): Remove hack for broken `with-suppressed-warnings'. diff --git a/test/lisp/obsolete/cl-tests.el b/test/lisp/obsolete/cl-tests.el index 0b8c1178f3..659c51ebcf 100644 --- a/test/lisp/obsolete/cl-tests.el +++ b/test/lisp/obsolete/cl-tests.el @@ -25,17 +25,11 @@ (require 'cl)) (require 'ert) - - -;; Hack to work around the ERT limitation that we can't reliably use -;; `with-suppressed-warnings' inside an `ert-deftest'. (Bug#36568) -(defun cl-tests-labels-test () - (with-suppressed-warnings ((obsolete labels)) - (funcall (labels ((foo () t)) - #'foo)))) - (ert-deftest labels-function-quoting () "Test that #'foo does the right thing in `labels'." ; Bug#31792. - (should (eq (cl-tests-labels-test) t))) + (with-suppressed-warnings ((obsolete labels)) + (should (eq (funcall (labels ((foo () t)) + #'foo)) + t)))) ;;; cl-tests.el ends here diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el index dd430cac2f..2e0d1529a5 100644 --- a/test/lisp/tar-mode-tests.el +++ b/test/lisp/tar-mode-tests.el @@ -24,12 +24,6 @@ (defvar tar-mode-tests-data-directory (expand-file-name "test/data/decompress" source-directory)) -;; Hack to work around the ERT limitation that we can't reliably use -;; `with-suppressed-warnings' inside an `ert-deftest'. (Bug#36568) -(defun tar-mode-tests--tar-grind-file-mode (&rest args) - (with-suppressed-warnings ((obsolete tar-grind-file-mode)) - (apply #'tar-grind-file-mode args))) - (ert-deftest tar-mode-test-tar-grind-file-mode () (let ((alist (list (cons 448 "rwx------") (cons 420 "rw-r--r--") @@ -38,7 +32,8 @@ (cons 1024 "-----S---") (cons 2048 "--S------")))) (dolist (x alist) - (should (equal (cdr x) (tar-mode-tests--tar-grind-file-mode (car x))))))) + (with-suppressed-warnings ((obsolete tar-grind-file-mode)) + (should (equal (cdr x) (tar-grind-file-mode (car x)))))))) (ert-deftest tar-mode-test-tar-extract-gz () (skip-unless (executable-find "gzip")) commit bf869aa698a3c7f09cf9614b80906fcb4d343aba Author: Eli Zaretskii <eliz@gnu.org> Date: Sun Dec 5 12:12:00 2021 +0200 ; * doc/misc/eshell.texi (Built-ins): Improve markup, fix typos. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index ef82c889a6..4e5288ea6d 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -317,27 +317,36 @@ command reverts to the system's definition of @command{cat}. @item cd @cmindex cd This command changes the current working directory. Usually, it is -invoked as @samp{cd foo} where @file{foo} is the new working directory. -But @command{cd} knows about a few special arguments: +invoked as @kbd{cd @var{dir}} where @file{@var{dir}} is the new +working directory. But @command{cd} knows about a few special +arguments: +@itemize @minus{} +@item When it receives no argument at all, it changes to the home directory. -Giving the command @samp{cd -} changes back to the previous working -directory (this is the same as @samp{cd $-}). +@item +Giving the command @kbd{cd -} changes back to the previous working +directory (this is the same as @kbd{cd $-}). -The command @samp{cd =} shows the directory stack. Each line is +@item +The command @kbd{cd =} shows the directory stack. Each line is numbered. -With @samp{cd =foo}, Eshell searches the directory stack for a directory -matching the regular expression @samp{foo} and changes to that +@item +With @kbd{cd =foo}, Eshell searches the directory stack for a directory +matching the regular expression @samp{foo}, and changes to that directory. -With @samp{cd -42}, you can access the directory stack by number. +@item +With @kbd{cd -42}, you can access the directory stack slots by number. +@item If @code{eshell-cd-shows-directory} is non-@code{nil}, @command{cd} will report the directory it changes to. If @code{eshell-list-files-after-cd} is non-@code{nil}, then @command{ls} is called with any remaining arguments after changing directories. +@end itemize @item clear @cmindex clear @@ -398,7 +407,7 @@ Summarize disk usage for each file. @item echo @cmindex echo -Echos its input. If @code{eshell-plain-echo-behavior} is +Echoes its input. If @code{eshell-plain-echo-behavior} is non-@code{nil}, @command{echo} will try to behave more like a plain shell's @command{echo}. @@ -461,7 +470,8 @@ reader. @item intersection @cmindex intersection -A wrapper around the function @code{cl-intersection}. This command +A wrapper around the function @code{cl-intersection} (@pxref{Lists as +Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. This command can be loaded as part of the eshell-xtra module, which is @@ -509,11 +519,12 @@ Lists the contents of directories. If @code{eshell-ls-use-colors} is non-@code{nil}, the contents of a directory is color-coded according to file type and status. These colors and the regexps used to identify their corresponding files can -be customized via @samp{M-x customize-group RET eshell-ls RET}. +be customized via @w{@kbd{M-x customize-group @key{RET} eshell-ls @key{RET}}}. The user option @code{eshell-ls-date-format} determines how the date is displayed when using the @option{-l} option. The date is produced -using the function @code{format-time-string}. +using the function @code{format-time-string} (@pxref{Time Parsing,,, +elisp, GNU Emacs Lisp Reference Manual}). The user option @code{eshell-ls-initial-args} contains a list of arguments to include with any call to @command{ls}. For example, you @@ -537,8 +548,9 @@ Display Man pages using the Emacs @code{man} command. @item mismatch @cmindex mismatch -A wrapper around the function @code{cl-mismatch}. This command can be -used for comparing lists of strings. +A wrapper around the function @code{cl-mismatch} (@pxref{Searching +Sequences,,, cl, GNU Emacs Common Lisp Emulation}). This command can +be used for comparing lists of strings. This command can be loaded as part of the eshell-xtra module, which is disabled by default. @@ -572,8 +584,8 @@ Print the arguments separated by newlines. @item pushd @cmindex pushd -Change to a directory and push that directory onto the directory -stack. +Push the current directory onto the directory stack, then change to +another directory. If @code{eshell-pushd-dunique} is non-@code{nil}, then only unique directories will be added to the stack. If @@ -601,7 +613,8 @@ Removes directories if they are empty. @item set-difference @cmindex set-difference -A wrapper around the function @code{cl-set-difference}. This command +A wrapper around the function @code{cl-set-difference} (@pxref{Lists as +Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. This command can be loaded as part of the eshell-xtra module, which is @@ -609,8 +622,9 @@ disabled by default. @item set-exclusive-or @cmindex set-exclusive-or -A wrapper around the function @code{cl-set-exclusive-or}. This -command can be used for comparing lists of strings. +A wrapper around the function @code{cl-set-exclusive-or} (@pxref{Lists +as Sets,,, cl, GNU Emacs Common Lisp Emulation}). This command can be +used for comparing lists of strings. This command can be loaded as part of the eshell-xtra module, which is disabled by default. @@ -618,6 +632,7 @@ disabled by default. @item setq @cmindex setq Set variable values, using the function @code{setq} like a command. +@xref{Setting variables,,, elisp, GNU Emacs Lisp Reference Manual}. @item source @cmindex source @@ -636,7 +651,8 @@ are in the eshell-tramp module, which is disabled by default. @item substitute @cmindex substitute -A wrapper around the function @code{cl-substitute}. This command can +A wrapper around the function @code{cl-substitute} (@pxref{Sequence +Functions,,, cl, GNU Emacs Common Lisp Emulation}). This command can be used for comparing lists of strings. This command can be loaded as part of the eshell-xtra module, which is @@ -653,8 +669,9 @@ directories. @item union @cmindex union -A wrapper around the function @code{cl-union}. This command can be -used for comparing lists of strings. +A wrapper around the function @code{cl-union} (@pxref{Lists as Sets,,, +cl, GNU Emacs Common Lisp Emulation}). This command can be used for +comparing lists of strings. This command can be loaded as part of the eshell-xtra module, which is disabled by default.